26 lines
1008 B
Mathematica
26 lines
1008 B
Mathematica
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
|