45 lines
2.2 KiB
Mathematica
45 lines
2.2 KiB
Mathematica
PRCFGPF ;SF-ISC/TKW,WISC/DGL-PROCESS GENERAL POST FUNDS 2237 REQUEST IN FISCAL ; [6/26/98 11:05am]
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
EN S PRCF("X")="SP" D ^PRCFSITE Q:'% S PRCFGPF=1
|
|
; ALLOW SELECTION ONLY OF GPF TRANSACTIONS WITH SUPPLY STATUS='FISCAL ACTION REQUIRED'
|
|
EN0 D:'$D(MESSAGE) ES Q:'$D(MESSAGE) S PRCFDICS=" I $O(^PRCD(442.3,""C"",+$P(^PRC(443,Y,0),U,7),0))=10" D TR^PRCHG G:'$D(DA) Q
|
|
S DIE="^PRC(443,",DR=1.5 D ^DIE K DIE,DR
|
|
S PRCFG=$S($D(^PRCD(442.3,+$P(^PRC(443,DA,0),U,7),0)):$P(^(0),U,2),1:"") D REMOVE^PRCHES11(DA) S P=+PRC("PER")
|
|
G:PRCFG=10 EN0
|
|
;IF RETURNED TO SERVICE
|
|
I PRCFG=85 D RTS G EN0
|
|
;IF APPROVED, AFFIX FISCAL SIGNATURE AND PRINT 2237 IN SUPPLY.
|
|
S MESSAGE=""
|
|
D ENCODE^PRCSC3(DA,DUZ,.MESSAGE)
|
|
I MESSAGE<0 W !,"Electronic Signature failure: ",MESSAGE G Q
|
|
S PRCHQ=$P(^PRCS(410,DA,0),U,4),D0=DA,PRCHQ=$S(PRCHQ=5:"DQ^PRCPRIB0",1:"QUE^PRCSP12"),PRCHQ("DEST")="S" D ^PRCHQUE G EN0
|
|
ES G Q:'$D(PRC("PER"))!('$D(PRC("SITE")))
|
|
S MESSAGE=""
|
|
D ESIG^PRCUESIG(DUZ,.MESSAGE)
|
|
G Q:MESSAGE'=1
|
|
Q
|
|
Q K %,DA,DIC,DIE,DR,MESSAGE,P,PRC,PRCF,PRCFDICS,PRCFGPF,PRCFG,PRCHNM,PRCHQ Q
|
|
RTS ;UPDATE COMMITTED CP BALANCE, REMOVE CP OFFICIAL SIGNATURE, ALLOW FISCAL TO ENTER COMMENTS, UPDATE QTY.DUE-IN IF SERVICE RUNNING INVENTORY, SEND BULLETIN
|
|
S X=+$P($G(^PRCS(410,DA,4)),"^",8)
|
|
D TRANK^PRCSES,REMOVE^PRCSC1(DA),REMOVE^PRCSC3(DA)
|
|
S $P(^PRCS(410,DA,10),U,4)=$P(^PRC(443,DA,0),U,7),DIE="^PRCS(410,",DR=61
|
|
D ^DIE K DIE D EN3^PRCPWI
|
|
S XMB="PRCH GPF"
|
|
S XMB(1)=$P(^PRCS(410,DA,0),U,4),XMB(1)=$S($P(^PRCS(410.5,XMB(1),0),U)'["1358":"2237",1:"2237")
|
|
S XMB(2)="FISCAL",XMB(3)=$P(^PRCS(410,DA,0),U,1)
|
|
S XMB(4)=$P(^PRCS(410,DA,4),U,1),XMB(5)=$P(XMB(3),"-",4)
|
|
K ^TMP("PRCFGPF",$J)
|
|
S XMTEXT="^TMP(""PRCFGPF"",$J,",XX=0,X=1,^TMP("PRCFGPF",$J,X)=" Purpose: "
|
|
F S XX=$O(^PRCS(410,DA,8,XX)) Q:XX="" S X=X+1,^TMP("PRCFGPF",$J,X)=$G(^PRCS(410,DA,8,XX,0))
|
|
S XX=0,X=X+1,^TMP("PRCFGPF",$J,X)=""
|
|
S X=X+1,^TMP("PRCFGPF",$J,X)=" Reason for return: "
|
|
F S XX=$O(^PRCS(410,DA,13,XX)) Q:XX="" S X=X+1,^TMP("PRCFGPF",$J,X)=$G(^PRCS(410,DA,13,XX,0))
|
|
S X="" K XMY
|
|
F I=0:0 S X=$O(^PRC(420,PRC("SITE"),1,XMB(5),1,X)) Q:X="" D
|
|
. S A=$G(^(X,0))
|
|
. I $P(A,U,3)="Y" S XMY(X)=""
|
|
. Q
|
|
D ^XMB K ^TMP("PRCFGPF",$J)
|
|
Q
|