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