PRCEFIS4 ;WISC/CTB/CLH-POST LIQUIDATION WHILE IN CODE SHEET MODULE ; 10/10/97 1400
V ;;5.1;IFCAP;**90**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q:$D(PRCFA(1358))
S PRCFA("CSM")="",ZX=$O(^PRCD(442.5,"C",1358,0))
S PODA=$S($G(PRCFA("PODA"))]"":PRCFA("PODA"),$G(PRCF("PODA"))]"":PRCF("PODA"),1:"")
D PO^PRCH58OB(.PODA,.PO)
S PRCFA("TRDA")=$P(PO(0),"^",12) I PRCFA("TRDA")'>0 K PRCFA("TRDA") G EX1
G:$P(PO(0),"^",2)'=ZX EX1
I $D(PRCFD("PAYMENT")) G CI
G OUT
;post 1358 liquidation is not asked - plt 4/93
;K ZX S DIR("A")="Do you wish to post a liquidation to the 1358 now",DIR("B")="No",DIR(0)="YO",DIR("?")="Enter YES to post, <RETURN> or No to quit"
;D ^DIR I Y'=1 G OUT
CI S:$G(PRCFA("PODA"))="" PRCFA("PODA")=$S($G(PODA)]"":PODA,$G(PRCF("PODA"))]"":PRCF("PODA"),1:"") D EN1^PRCELIQ
OUT ;W:'$D(PRCFD("PAYMENT")) !!,"Returning to Code Sheet Module",!!,$C(7) Q
Q
EX1 K %,DIC,DIE,DR,PRCFA("CSM"),X,X1,ZX Q
;
EOM ; PRINT END OF MONTH REPORT
S DIC="^PRC(442,",L=0,(BY,FLDS)="[PRCE 1358 EOM REPORT]" D EN1^DIP Q
;
PRINT ;PRINT ANY 1358
S ZX=$O(^PRCD(442.5,"C",1358,0)) I ZX="" W !,"Error in PAT Type file, Contact your IFCAP coordinator.",$C(7),!! K ZX Q
W !,"Brief or Standard output? (B/S): B// " R X:DTIME Q:'$T!(X["^") S:X="" X="B" I "BbSs?"'[$E(X,1) W "?? B(rief) or S(tandard) ONLY",$C(7) G PRINT
I $E(X,1)["?" W !," The Standard output is the complete 1358 document, the Brief output provides",!," only the transaction information." G PRINT
I "Bb"[$E(X,1) F I=1:1 D ^PRCEFIS5 K PO,IOINHI,IOINLOW,IOINORM,ZX S %A="Do you wish to view another 1358",%B="",%=1 D ^PRCFYN K:%=1 PRC("CP") G:%=1 PRINT K I G EXIT
I '$D(PRC("SITE")) S PRCF("X")="AS" D ^PRCFSITE
S REP="PRCEFIS4" D PRF58E^PRCE58P
REP I $D(REP) S %A="Do you wish to print another 1358",%B="",%=2 D ^PRCFYN I %=1 W !! K PRC("CP") G PRINT
EXIT K %,%DT,%ZIS,BY,C2,C3,D,DA,DHD,DIE,PRCS,PRCSQ,FLDS,REP,FR,I,IOP,L,N,TO,X,Y,PRC("CP")
S:$D(PRCXSITE) PRC("SITE")=PRCXSITE S:$D(PRCXCP) PRC("CP")=PRCXCP K PRCXCP,PRCXSITE Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCEFIS4 2075 printed Sep 23, 2025@19:37:31 Page 2
PRCEFIS4 ;WISC/CTB/CLH-POST LIQUIDATION WHILE IN CODE SHEET MODULE ; 10/10/97 1400
V ;;5.1;IFCAP;**90**;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 if $DATA(PRCFA(1358))
QUIT
+3 SET PRCFA("CSM")=""
SET ZX=$ORDER(^PRCD(442.5,"C",1358,0))
+4 SET PODA=$SELECT($GET(PRCFA("PODA"))]"":PRCFA("PODA"),$GET(PRCF("PODA"))]"":PRCF("PODA"),1:"")
+5 DO PO^PRCH58OB(.PODA,.PO)
+6 SET PRCFA("TRDA")=$PIECE(PO(0),"^",12)
IF PRCFA("TRDA")'>0
KILL PRCFA("TRDA")
GOTO EX1
+7 if $PIECE(PO(0),"^",2)'=ZX
GOTO EX1
+8 IF $DATA(PRCFD("PAYMENT"))
GOTO CI
+9 GOTO OUT
+10 ;post 1358 liquidation is not asked - plt 4/93
+11 ;K ZX S DIR("A")="Do you wish to post a liquidation to the 1358 now",DIR("B")="No",DIR(0)="YO",DIR("?")="Enter YES to post, <RETURN> or No to quit"
+12 ;D ^DIR I Y'=1 G OUT
CI if $GET(PRCFA("PODA"))=""
SET PRCFA("PODA")=$SELECT($GET(PODA)]"":PODA,$GET(PRCF("PODA"))]"":PRCF("PODA"),1:"")
DO EN1^PRCELIQ
OUT ;W:'$D(PRCFD("PAYMENT")) !!,"Returning to Code Sheet Module",!!,$C(7) Q
+1 QUIT
EX1 KILL %,DIC,DIE,DR,PRCFA("CSM"),X,X1,ZX
QUIT
+1 ;
EOM ; PRINT END OF MONTH REPORT
+1 SET DIC="^PRC(442,"
SET L=0
SET (BY,FLDS)="[PRCE 1358 EOM REPORT]"
DO EN1^DIP
QUIT
+2 ;
PRINT ;PRINT ANY 1358
+1 SET ZX=$ORDER(^PRCD(442.5,"C",1358,0))
IF ZX=""
WRITE !,"Error in PAT Type file, Contact your IFCAP coordinator.",$CHAR(7),!!
KILL ZX
QUIT
+2 WRITE !,"Brief or Standard output? (B/S): B// "
READ X:DTIME
if '$TEST!(X["^")
QUIT
if X=""
SET X="B"
IF "BbSs?"'[$EXTRACT(X,1)
WRITE "?? B(rief) or S(tandard) ONLY",$CHAR(7)
GOTO PRINT
+3 IF $EXTRACT(X,1)["?"
WRITE !," The Standard output is the complete 1358 document, the Brief output provides",!," only the transaction information."
GOTO PRINT
+4 IF "Bb"[$EXTRACT(X,1)
FOR I=1:1
DO ^PRCEFIS5
KILL PO,IOINHI,IOINLOW,IOINORM,ZX
SET %A="Do you wish to view another 1358"
SET %B=""
SET %=1
DO ^PRCFYN
if %=1
KILL PRC("CP")
if %=1
GOTO PRINT
KILL I
GOTO EXIT
+5 IF '$DATA(PRC("SITE"))
SET PRCF("X")="AS"
DO ^PRCFSITE
+6 SET REP="PRCEFIS4"
DO PRF58E^PRCE58P
REP IF $DATA(REP)
SET %A="Do you wish to print another 1358"
SET %B=""
SET %=2
DO ^PRCFYN
IF %=1
WRITE !!
KILL PRC("CP")
GOTO PRINT
EXIT KILL %,%DT,%ZIS,BY,C2,C3,D,DA,DHD,DIE,PRCS,PRCSQ,FLDS,REP,FR,I,IOP,L,N,TO,X,Y,PRC("CP")
+1 if $DATA(PRCXSITE)
SET PRC("SITE")=PRCXSITE
if $DATA(PRCXCP)
SET PRC("CP")=PRCXCP
KILL PRCXCP,PRCXSITE
QUIT
+2 QUIT
