| 1 | PRCFGPF ;SF-ISC/TKW,WISC/DGL-PROCESS GENERAL POST FUNDS 2237 REQUEST IN FISCAL ; [6/26/98 11:05am]
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN S PRCF("X")="SP" D ^PRCFSITE Q:'% S PRCFGPF=1
|
|---|
| 5 | ; ALLOW SELECTION ONLY OF GPF TRANSACTIONS WITH SUPPLY STATUS='FISCAL ACTION REQUIRED'
|
|---|
| 6 | 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
|
|---|
| 7 | S DIE="^PRC(443,",DR=1.5 D ^DIE K DIE,DR
|
|---|
| 8 | 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")
|
|---|
| 9 | G:PRCFG=10 EN0
|
|---|
| 10 | ;IF RETURNED TO SERVICE
|
|---|
| 11 | I PRCFG=85 D RTS G EN0
|
|---|
| 12 | ;IF APPROVED, AFFIX FISCAL SIGNATURE AND PRINT 2237 IN SUPPLY.
|
|---|
| 13 | S MESSAGE=""
|
|---|
| 14 | D ENCODE^PRCSC3(DA,DUZ,.MESSAGE)
|
|---|
| 15 | I MESSAGE<0 W !,"Electronic Signature failure: ",MESSAGE G Q
|
|---|
| 16 | 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
|
|---|
| 17 | ES G Q:'$D(PRC("PER"))!('$D(PRC("SITE")))
|
|---|
| 18 | S MESSAGE=""
|
|---|
| 19 | D ESIG^PRCUESIG(DUZ,.MESSAGE)
|
|---|
| 20 | G Q:MESSAGE'=1
|
|---|
| 21 | Q
|
|---|
| 22 | Q K %,DA,DIC,DIE,DR,MESSAGE,P,PRC,PRCF,PRCFDICS,PRCFGPF,PRCFG,PRCHNM,PRCHQ Q
|
|---|
| 23 | RTS ;UPDATE COMMITTED CP BALANCE, REMOVE CP OFFICIAL SIGNATURE, ALLOW FISCAL TO ENTER COMMENTS, UPDATE QTY.DUE-IN IF SERVICE RUNNING INVENTORY, SEND BULLETIN
|
|---|
| 24 | S X=+$P($G(^PRCS(410,DA,4)),"^",8)
|
|---|
| 25 | D TRANK^PRCSES,REMOVE^PRCSC1(DA),REMOVE^PRCSC3(DA)
|
|---|
| 26 | S $P(^PRCS(410,DA,10),U,4)=$P(^PRC(443,DA,0),U,7),DIE="^PRCS(410,",DR=61
|
|---|
| 27 | D ^DIE K DIE D EN3^PRCPWI
|
|---|
| 28 | S XMB="PRCH GPF"
|
|---|
| 29 | 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")
|
|---|
| 30 | S XMB(2)="FISCAL",XMB(3)=$P(^PRCS(410,DA,0),U,1)
|
|---|
| 31 | S XMB(4)=$P(^PRCS(410,DA,4),U,1),XMB(5)=$P(XMB(3),"-",4)
|
|---|
| 32 | K ^TMP("PRCFGPF",$J)
|
|---|
| 33 | S XMTEXT="^TMP(""PRCFGPF"",$J,",XX=0,X=1,^TMP("PRCFGPF",$J,X)=" Purpose: "
|
|---|
| 34 | 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))
|
|---|
| 35 | S XX=0,X=X+1,^TMP("PRCFGPF",$J,X)=""
|
|---|
| 36 | S X=X+1,^TMP("PRCFGPF",$J,X)=" Reason for return: "
|
|---|
| 37 | 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))
|
|---|
| 38 | S X="" K XMY
|
|---|
| 39 | F I=0:0 S X=$O(^PRC(420,PRC("SITE"),1,XMB(5),1,X)) Q:X="" D
|
|---|
| 40 | . S A=$G(^(X,0))
|
|---|
| 41 | . I $P(A,U,3)="Y" S XMY(X)=""
|
|---|
| 42 | . Q
|
|---|
| 43 | D ^XMB K ^TMP("PRCFGPF",$J)
|
|---|
| 44 | Q
|
|---|
