source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFAC0J.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.0 KB
Line 
1PRCFAC0J ;WISC/CLH-JUSTIFICATION DISPLAY ;2/20/92 2:04 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 D HILO^PRCFQ
5 W IOINHI,"Justification(s): ",IOINORM,!!
6 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
7 I 'PRCFA("NO") W ?15,IOINHI,$C(7),"No Justification Information shown.",!!,IOINORM
8 Q
9DIS ;DISPLAY JUSTIFICATION OFF 2237
10 W ?5,"Transaction Number: ",IOINHI,$P(^PRCS(410,PRCFA("JUST"),0),"^"),!!,IOINORM
11 K ^UTILITY($J,"W") S DIWL=10,DIWR=60,DIWF="W" D HANG:$Y+5>IOSL I $D(PRCFAX) K PRCFAX Q
12 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))
13 D:$D(PRCFA("XX")) ^DIWW
14 W ! S PRCFA("NO")=1 Q
15HANG ;PAUSE ON SCREEN
16 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
17 W @IOF Q
Note: See TracBrowser for help on using the repository browser.