source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHDAM0.m@ 1006

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

initial load of WorldVistAEHR

File size: 1008 bytes
Line 
1PRCHDAM0 ;ID/RSD-DISPLAY AN AMENDMENT CONTINUED ;7/27/94 9:15 AM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4REASON ;Come here to display the JUSTIFICATION field on the AMENDMENT display.
5 N LINE1,LINE2,LINE3,LINE4,F1,PRCHD4,LONG
6 K LINE1,LINE2,LINE3,LINE4 S F1=0
7 S PRCHD4=$G(^PRC(443.6,D0,6,D1,4)) Q:PRCHD4=""
8 I $L(PRCHD4)>65 S F1=1 D
9 .S LONG=65 F Q:$A(PRCHD4,LONG)=32 S LONG=LONG-1
10 .S LINE1=$E(PRCHD4,1,LONG-1),PRCHD4=$E(PRCHD4,LONG+1,240)
11 .S LINE1="JUSTIFICATION: "_LINE1
12 .I $L(PRCHD4)>80 D Q
13 ..S LONG=80 F Q:$A(PRCHD4,LONG)=32 S LONG=LONG-1
14 ..S LINE2=$E(PRCHD4,1,LONG-1),PRCHD4=$E(PRCHD4,LONG+1,240)
15 ..I $L(PRCHD4)>80 D Q
16 ...S LONG=80 F Q:$A(PRCHD4,LONG)=32 S LONG=LONG-1
17 ...S LINE3=$E(PRCHD4,1,LONG-1),LINE4=$E(PRCHD4,LONG+1,240)
18 ..S LINE3=PRCHD4
19 ..Q
20 .I $L(PRCHD4)'>80 S LINE2=PRCHD4
21 .Q
22 I F1=0 S LINE1=PRCHD4,LINE1="JUSTIFICATION: "_LINE1
23 W !,LINE1 W:$D(LINE2) !,LINE2 W:$D(LINE3) !,LINE3 W:$D(LINE4) !,LINE4
24 W !,PRCHDUL
25 Q
Note: See TracBrowser for help on using the repository browser.