PRCFAC0J ;WISC/CLH-JUSTIFICATION DISPLAY ;2/20/92 2:04 PM
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
D HILO^PRCFQ
W IOINHI,"Justification(s): ",IOINORM,!!
S (PRCFA("NO"),PRCFA("JUST"))=0 F J=1:1 S PRCFA("JUST")=$O(^PRC(442,PRCFA("PODA"),13,PRCFA("JUST"))) Q:'PRCFA("JUST") I $D(^PRCS(410,PRCFA("JUST"),8)) D DIS
I 'PRCFA("NO") W ?15,IOINHI,$C(7),"No Justification Information shown.",!!,IOINORM
Q
DIS ;DISPLAY JUSTIFICATION OFF 2237
W ?5,"Transaction Number: ",IOINHI,$P(^PRCS(410,PRCFA("JUST"),0),"^"),!!,IOINORM
K ^UTILITY($J,"W") S DIWL=10,DIWR=60,DIWF="W" D HANG:$Y+5>IOSL I $D(PRCFAX) K PRCFAX Q
S PRCFA("J1")=0 F L=0:0 S PRCFA("J1")=$O(^PRCS(410,PRCFA("JUST"),8,PRCFA("J1"))) Q:'PRCFA("J1") D:$Y+5>IOSL HANG Q:$D(PRCFAX) S PRCFA("XX")=^(PRCFA("J1"),0) S X=PRCFA("XX") D DIWP^PRCUTL($G(DA))
D:$D(PRCFA("XX")) ^DIWW
W ! S PRCFA("NO")=1 Q
HANG ;PAUSE ON SCREEN
K PRCFAX I $E(IOST,1,2)["C-" R !,"Enter '^' to quit, Press return to continue: ",XX:$S($D(DTIME):DTIME,1:60) S:XX="^" PRCFAX=1
W @IOF Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFAC0J 1086 printed Dec 13, 2024@02:01:50 Page 2
PRCFAC0J ;WISC/CLH-JUSTIFICATION DISPLAY ;2/20/92 2:04 PM
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 DO HILO^PRCFQ
+3 WRITE IOINHI,"Justification(s): ",IOINORM,!!
+4 SET (PRCFA("NO"),PRCFA("JUST"))=0
FOR J=1:1
SET PRCFA("JUST")=$ORDER(^PRC(442,PRCFA("PODA"),13,PRCFA("JUST")))
if 'PRCFA("JUST")
QUIT
IF $DATA(^PRCS(410,PRCFA("JUST"),8))
DO DIS
+5 IF 'PRCFA("NO")
WRITE ?15,IOINHI,$CHAR(7),"No Justification Information shown.",!!,IOINORM
+6 QUIT
DIS ;DISPLAY JUSTIFICATION OFF 2237
+1 WRITE ?5,"Transaction Number: ",IOINHI,$PIECE(^PRCS(410,PRCFA("JUST"),0),"^"),!!,IOINORM
+2 KILL ^UTILITY($JOB,"W")
SET DIWL=10
SET DIWR=60
SET DIWF="W"
if $Y+5>IOSL
DO HANG
IF $DATA(PRCFAX)
KILL PRCFAX
QUIT
+3 SET PRCFA("J1")=0
FOR L=0:0
SET PRCFA("J1")=$ORDER(^PRCS(410,PRCFA("JUST"),8,PRCFA("J1")))
if 'PRCFA("J1")
QUIT
if $Y+5>IOSL
DO HANG
if $DATA(PRCFAX)
QUIT
SET PRCFA("XX")=^(PRCFA("J1"),0)
SET X=PRCFA("XX")
DO DIWP^PRCUTL($GET(DA))
+4 if $DATA(PRCFA("XX"))
DO ^DIWW
+5 WRITE !
SET PRCFA("NO")=1
QUIT
HANG ;PAUSE ON SCREEN
+1 KILL PRCFAX
IF $EXTRACT(IOST,1,2)["C-"
READ !,"Enter '^' to quit, Press return to continue: ",XX:$SELECT($DATA(DTIME):DTIME,1:60)
if XX="^"
SET PRCFAX=1
+2 WRITE @IOF
QUIT
