44 lines
1.4 KiB
Mathematica
44 lines
1.4 KiB
Mathematica
PRCPUFCP ;WISC/RFJ/DGL-select fund control point utility ; 10.19.99
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
;
|
|
;
|
|
SELECT(TYPE) ; select fund control point
|
|
; if type (of inventory point set) use screen for lookup
|
|
N %,C,DA,DIC,DISYS,X,Y
|
|
I '$D(^PRC(420,+$G(PRC("SITE")),0)) Q 0
|
|
I '$D(^PRC(420,PRC("SITE"),1,0)) S ^(0)="^420.01^^"
|
|
S DIC="^PRC(420,"_PRC("SITE")_",1,",DA(1)=PRC("SITE"),DIC(0)="QEAMZ"
|
|
S DIC("W")="D DISPIP^PRCPUTIL(Y)"
|
|
S DIC("S")="I $O(^PRC(420,PRC(""SITE""),1,+Y,1,0))"
|
|
I TYPE'="" S DIC("S")=DIC("S")_","_$S(TYPE="W":"$P(^PRC(420,PRC(""SITE""),1,+Y,0),U,12)=2",1:"$P(^PRC(420,PRC(""SITE""),1,+Y,0),U,12)'=2")
|
|
W ! D ^DIC
|
|
Q +Y
|
|
;
|
|
;
|
|
SET(FCPDA,INVPT) ; set invpt to fund control point
|
|
I '$D(^PRC(420,$G(PRC("SITE")),1,+FCPDA,0)) Q
|
|
I $D(^PRC(420,"AE",$G(PRC("SITE")),INVPT,+FCPDA)) Q
|
|
N %,D,D0,DA,DI,DIC,DIE,DO,DQ,DR,X,Y,PRCPPRIV
|
|
S PRCPPRIV=1
|
|
S DIC="^PRC(420,"_PRC("SITE")_",1,"_+FCPDA_",7,",X=INVPT
|
|
S DIC("P")=$P(^DD(420.01,17.5,0),U,2)
|
|
S DA(1)=+FCPDA,DA(2)=PRC("SITE"),DIC(0)="L",DLAYGO=420
|
|
D FILE^DICN
|
|
Q
|
|
;
|
|
;
|
|
DEL(FCPDA,INVPT) ; delete invpt from control point
|
|
I '$D(^PRC(420,"AE",$G(PRC("SITE")),INVPT,+FCPDA)) Q
|
|
N %,DA,DIC,DIK,X,Y
|
|
S DA=0
|
|
S DA=$O(^PRC(420,PRC("SITE"),1,+FCPDA,7,"B",INVPT,DA)) Q:'DA
|
|
S DIK="^PRC(420,"_PRC("SITE")_",1,"_FCPDA_",7,"
|
|
S DA(1)=+FCPDA,DA(2)=PRC("SITE"),X=INVPT
|
|
D ^DIK
|
|
Q
|
|
;
|
|
;
|
|
; PRCPUFCP
|