- 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 Mar 13, 2025@21:11:15 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
