PRCE58P ;WISC/SAW/LDB-CONTROL POINT ACTIVITY 1358 DISPLAY CON'T ; 2/29/00 3:39pm
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
PRF58 ;PRINT 1358 ONLY
D EN3^PRCSUT G W1:'$D(PRC("SITE")),EXIT:Y<0
PRF58E S DIC="^PRCS(410," D OROBL^PRCS58OB(DIC,.PRC,.DA) G EXIT:Y<0 K DIC("S") S DA=+Y
D NODE^PRCS58OB(DA,.TRNODE)
I '$D(PRC("CP")) S PRC("CP")=$P(TRNODE(0),"-",4)
PRF2 K PRCSA W !,"Would you like to print the Description field for each 1358 Daily Record entry" S %=2 D YN^DICN G PRF2:%=0,EXIT:%<0 I %=1 S PRCSA=1
S DIR("A")="Would you like to print the daily records for each authorization? ",DIR(0)="YAO",DIR("B")="NO"
S DIR("?")="Answer 'yes' to see the all the payments for each authorization." D ^DIR G:$D(DIRUT) EXIT S PRCSA1=Y G:Y=0 PRF3
S DIR("A")="Would you like to print descriptions for each detailed daily record? ",DIR("?")="Answer 'yes' if you would like to see the description printed for each record."
D ^DIR
I $D(DIRUT) S PRCSA2=0 G EXIT
S PRCSA2=Y
PRF3 D DEV G EXIT:POP
I $D(IO("Q")) K IO("Q") S ZTRTN="^PRCE58P2",ZTSAVE("DA")="",ZTSAVE("PRC*")="" D ^%ZTLOAD G:$D(PRCSF) EXIT Q:$G(REP)="PRCEFIS4" D W2 G PRF58
I $E(IOST)="P" D ^PRCE58P2 D ^%ZISC G:$D(PRCSF) EXIT Q:$G(REP)="PRCEFIS4" D W2 G PRF58
D ^PRCE58P0 W:$Y>0 @IOF Q:$D(PRCSF)!($G(REP)="PRCEFIS4") D W2 G PRF58
EXIT K %,%DT,%ZIS,BY,C2,C3,D,DA,DHD,DIC,DIE,PRCS,PRCSQ,FLDS,FR,I,L,N,TO,X,Y,ZTRTN,ZTSAVE
K DIR
Q
W2 W !!,"Enter information for another report or an uparrow to return to the menu.",! Q
DEV K IO("Q") S %ZIS("B")="HOME",%ZIS="MQ" D ^%ZIS Q
W1 W !!,"You are not an authorized control point user.",!,"Contact your control point official." R X:5 G EXIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCE58P 1719 printed Mar 13, 2025@21:05:56 Page 2
PRCE58P ;WISC/SAW/LDB-CONTROL POINT ACTIVITY 1358 DISPLAY CON'T ; 2/29/00 3:39pm
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
PRF58 ;PRINT 1358 ONLY
+1 DO EN3^PRCSUT
if '$DATA(PRC("SITE"))
GOTO W1
if Y<0
GOTO EXIT
PRF58E SET DIC="^PRCS(410,"
DO OROBL^PRCS58OB(DIC,.PRC,.DA)
if Y<0
GOTO EXIT
KILL DIC("S")
SET DA=+Y
+1 DO NODE^PRCS58OB(DA,.TRNODE)
+2 IF '$DATA(PRC("CP"))
SET PRC("CP")=$PIECE(TRNODE(0),"-",4)
PRF2 KILL PRCSA
WRITE !,"Would you like to print the Description field for each 1358 Daily Record entry"
SET %=2
DO YN^DICN
if %=0
GOTO PRF2
if %<0
GOTO EXIT
IF %=1
SET PRCSA=1
+1 SET DIR("A")="Would you like to print the daily records for each authorization? "
SET DIR(0)="YAO"
SET DIR("B")="NO"
+2 SET DIR("?")="Answer 'yes' to see the all the payments for each authorization."
DO ^DIR
if $DATA(DIRUT)
GOTO EXIT
SET PRCSA1=Y
if Y=0
GOTO PRF3
+3 SET DIR("A")="Would you like to print descriptions for each detailed daily record? "
SET DIR("?")="Answer 'yes' if you would like to see the description printed for each record."
+4 DO ^DIR
+5 IF $DATA(DIRUT)
SET PRCSA2=0
GOTO EXIT
+6 SET PRCSA2=Y
PRF3 DO DEV
if POP
GOTO EXIT
+1 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="^PRCE58P2"
SET ZTSAVE("DA")=""
SET ZTSAVE("PRC*")=""
DO ^%ZTLOAD
if $DATA(PRCSF)
GOTO EXIT
if $GET(REP)="PRCEFIS4"
QUIT
DO W2
GOTO PRF58
+2 IF $EXTRACT(IOST)="P"
DO ^PRCE58P2
DO ^%ZISC
if $DATA(PRCSF)
GOTO EXIT
if $GET(REP)="PRCEFIS4"
QUIT
DO W2
GOTO PRF58
+3 DO ^PRCE58P0
if $Y>0
WRITE @IOF
if $DATA(PRCSF)!($GET(REP)="PRCEFIS4")
QUIT
DO W2
GOTO PRF58
EXIT KILL %,%DT,%ZIS,BY,C2,C3,D,DA,DHD,DIC,DIE,PRCS,PRCSQ,FLDS,FR,I,L,N,TO,X,Y,ZTRTN,ZTSAVE
+1 KILL DIR
+2 QUIT
W2 WRITE !!,"Enter information for another report or an uparrow to return to the menu.",!
QUIT
DEV KILL IO("Q")
SET %ZIS("B")="HOME"
SET %ZIS="MQ"
DO ^%ZIS
QUIT
W1 WRITE !!,"You are not an authorized control point user.",!,"Contact your control point official."
READ X:5
GOTO EXIT
