PRCHDAM0 ;ID/RSD-DISPLAY AN AMENDMENT CONTINUED ;7/27/94 9:15 AM
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
REASON ;Come here to display the JUSTIFICATION field on the AMENDMENT display.
N LINE1,LINE2,LINE3,LINE4,F1,PRCHD4,LONG
K LINE1,LINE2,LINE3,LINE4 S F1=0
S PRCHD4=$G(^PRC(443.6,D0,6,D1,4)) Q:PRCHD4=""
I $L(PRCHD4)>65 S F1=1 D
.S LONG=65 F Q:$A(PRCHD4,LONG)=32 S LONG=LONG-1
.S LINE1=$E(PRCHD4,1,LONG-1),PRCHD4=$E(PRCHD4,LONG+1,240)
.S LINE1="JUSTIFICATION: "_LINE1
.I $L(PRCHD4)>80 D Q
..S LONG=80 F Q:$A(PRCHD4,LONG)=32 S LONG=LONG-1
..S LINE2=$E(PRCHD4,1,LONG-1),PRCHD4=$E(PRCHD4,LONG+1,240)
..I $L(PRCHD4)>80 D Q
...S LONG=80 F Q:$A(PRCHD4,LONG)=32 S LONG=LONG-1
...S LINE3=$E(PRCHD4,1,LONG-1),LINE4=$E(PRCHD4,LONG+1,240)
..S LINE3=PRCHD4
..Q
.I $L(PRCHD4)'>80 S LINE2=PRCHD4
.Q
I F1=0 S LINE1=PRCHD4,LINE1="JUSTIFICATION: "_LINE1
W !,LINE1 W:$D(LINE2) !,LINE2 W:$D(LINE3) !,LINE3 W:$D(LINE4) !,LINE4
W !,PRCHDUL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHDAM0 1033 printed Oct 16, 2024@18:07:12 Page 2
PRCHDAM0 ;ID/RSD-DISPLAY AN AMENDMENT CONTINUED ;7/27/94 9:15 AM
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
REASON ;Come here to display the JUSTIFICATION field on the AMENDMENT display.
+1 NEW LINE1,LINE2,LINE3,LINE4,F1,PRCHD4,LONG
+2 KILL LINE1,LINE2,LINE3,LINE4
SET F1=0
+3 SET PRCHD4=$GET(^PRC(443.6,D0,6,D1,4))
if PRCHD4=""
QUIT
+4 IF $LENGTH(PRCHD4)>65
SET F1=1
Begin DoDot:1
+5 SET LONG=65
FOR
if $ASCII(PRCHD4,LONG)=32
QUIT
SET LONG=LONG-1
+6 SET LINE1=$EXTRACT(PRCHD4,1,LONG-1)
SET PRCHD4=$EXTRACT(PRCHD4,LONG+1,240)
+7 SET LINE1="JUSTIFICATION: "_LINE1
+8 IF $LENGTH(PRCHD4)>80
Begin DoDot:2
+9 SET LONG=80
FOR
if $ASCII(PRCHD4,LONG)=32
QUIT
SET LONG=LONG-1
+10 SET LINE2=$EXTRACT(PRCHD4,1,LONG-1)
SET PRCHD4=$EXTRACT(PRCHD4,LONG+1,240)
+11 IF $LENGTH(PRCHD4)>80
Begin DoDot:3
+12 SET LONG=80
FOR
if $ASCII(PRCHD4,LONG)=32
QUIT
SET LONG=LONG-1
+13 SET LINE3=$EXTRACT(PRCHD4,1,LONG-1)
SET LINE4=$EXTRACT(PRCHD4,LONG+1,240)
End DoDot:3
QUIT
+14 SET LINE3=PRCHD4
+15 QUIT
End DoDot:2
QUIT
+16 IF $LENGTH(PRCHD4)'>80
SET LINE2=PRCHD4
+17 QUIT
End DoDot:1
+18 IF F1=0
SET LINE1=PRCHD4
SET LINE1="JUSTIFICATION: "_LINE1
+19 WRITE !,LINE1
if $DATA(LINE2)
WRITE !,LINE2
if $DATA(LINE3)
WRITE !,LINE3
if $DATA(LINE4)
WRITE !,LINE4
+20 WRITE !,PRCHDUL
+21 QUIT
