- 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
