- PSORLLL5 ;AITC/BWF - LASER LABEL CONTINUED ;11/14/05 10:09am
- ;;7.0;OUTPATIENT PHARMACY;**454**;DEC 1997;Build 349
- ; BWF - OneVa Pharmacy modified copy of PSOLLL5
- ;
- START ;
- N TEXT,BLNKLIN
- S $P(BLNKLIN,"_",90)="_"
- D MAIL
- I $G(PSOIO("ACI"))]"" X PSOIO("ACI")
- S TEXT="HAS YOUR ADDRESS CHANGED?" D STRT^PSOLLU1("SEC2",TEXT,.L)
- S OPSOX=PSOX,PSOX=4.2-L($E(PSOHFONT,2,99))*300/2+OPSOX
- S OFONT=PSOFONT,PSOFONT=$G(PSOHFONT,OFONT) D PRINT(TEXT,1) S PSOX=OPSOX,PSOY=PSOY+10,PSOFONT=OFONT
- S TEXT="Write address changes in the blanks, sign the form, and return to" D PRINT(TEXT,0)
- S TEXT="your pharmacy." D PRINT(TEXT,0)
- S X=$S($D(^DPT(DFN,0))#2:^(0),1:""),PNM=$P(X,"^")
- D PID^VADPT6,ADD^VADPT S SSNP=""
- S PSOY=PSOY+PSOYI,TEXT=PNM_" "_SSNP D PRINT(TEXT,0)
- I $G(VAPA(1))="" G ALLERGY
- F I=1:1:3 I $G(VAPA(I))]"" S TEXT=$G(VAPA(I))_$E(BLNKLIN,1,80-$L(VAPA(I))) D PRINT(TEXT,0)
- S A=+$G(VAPA(5)) I A S A=$S($D(^DIC(5,A,0)):$P(^(0),"^",2),1:"UNKNOWN")
- S B=$G(VAPA(4))_", "_A_" "_$S($G(VAPA(11)):$P(VAPA(11),"^",2),1:$G(VAPA(6)))
- S TEXT=B_$E(BLNKLIN,1,80-$L(B)) D PRINT(TEXT,0)
- S B=VAPA(8)
- S TEXT=B_$E(BLNKLIN,1,80-$L(B)) D PRINT(TEXT,0)
- S:$G(VAPA(3))="" PSOY=PSOY+PSOYI
- S TEXT="[ ] Permanent [ ] Temporary until ____/____/____" D PRINT(TEXT,0)
- S PSOY=$G(PSOFY),TEXT="Signature "_$E(BLNKLIN,1,45) D PRINT(TEXT,0)
- ;
- ALLERGY ;ALLERGIES & REACTIONS
- K ^TMP($J,"PSOALWA")
- S GMRA="0^0^111" D ^GMRADPT
- I $G(GMRAL) S PSORY=0 F S PSORY=$O(GMRAL(PSORY)) Q:'PSORY S ^TMP($J,"PSOALWA",$S($P(GMRAL(PSORY),"^",4):1,1:2),$S('$P(GMRAL(PSORY),"^",5):1,1:2),$P(GMRAL(PSORY),"^",7),$P(GMRAL(PSORY),"^",2))=""
- S ^TMP($J,"PSOAPT",1)=$G(PNM)_" "_$G(SSNP),^(2)="Verified Allergies"
- S ALCNT=0,EEE=0,(PSOLG,PSOLGA)="" F S PSOLG=$O(^TMP($J,"PSOALWA",1,1,PSOLG)) Q:PSOLG="" F S PSOLGA=$O(^TMP($J,"PSOALWA",1,1,PSOLG,PSOLGA)) Q:PSOLGA="" S EEE=1,ALCNT=ALCNT+1,^TMP($J,"PSOAPT",2,ALCNT)=PSOLGA
- I 'EEE,$G(GMRAL)=0 S ALCNT=ALCNT+1,^TMP($J,"PSOAPT",2,ALCNT)="NKA"
- S ALCNT=0,^TMP($J,"PSOAPT",3)="Non-Verified Allergies"
- S EEE=0,(PSOLG,PSOLGA)="" F S PSOLG=$O(^TMP($J,"PSOALWA",2,1,PSOLG)) Q:PSOLG="" F S PSOLGA=$O(^TMP($J,"PSOALWA",2,1,PSOLG,PSOLGA)) Q:PSOLGA="" S EEE=EEE+1,ALCNT=ALCNT+1,^TMP($J,"PSOAPT",3,ALCNT)=PSOLGA
- I 'EEE,$G(GMRAL)=0 S ALCNT=ALCNT+1,^TMP($J,"PSOAPT",3,ALCNT)="NKA"
- S ALCNT=0,^TMP($J,"PSOAPT",4)="Verified Adverse Reactions"
- S (PSOLG,PSOLGA)="" F S PSOLG=$O(^TMP($J,"PSOALWA",1,2,PSOLG)) Q:PSOLG="" F S PSOLGA=$O(^TMP($J,"PSOALWA",1,2,PSOLG,PSOLGA)) Q:PSOLGA="" S ALCNT=ALCNT+1,^TMP($J,"PSOAPT",4,ALCNT)=PSOLGA
- S ALCNT=0,^TMP($J,"PSOAPT",5)="Non-Verified Adverse Reactions"
- S (PSOLG,PSOLGA)="" F S PSOLG=$O(^TMP($J,"PSOALWA",2,2,PSOLG)) Q:PSOLG="" F S PSOLGA=$O(^TMP($J,"PSOALWA",2,2,PSOLG,PSOLGA)) Q:PSOLGA="" S ALCNT=ALCNT+1,^TMP($J,"PSOAPT",5,ALCNT)=PSOLGA
- I $G(PSOIO("ALI"))]"" X PSOIO("ALI")
- S XFONT=$E($G(PSOFONT),2,99)
- S OFONT=PSOFONT,PSOFONT=$G(PSOHFONT,PSOFONT) S TEXT=^TMP($J,"PSOAPT",1) D PRINT(TEXT,1) S PSOFONT=OFONT
- S TEXT="" D PRINT(TEXT,0)
- F CCC=3,4,5 I '$O(^TMP($J,"PSOAPT",CCC,0)) K ^TMP($J,"PSOAPT",CCC)
- D ASSESS
- I CCC="NKA" S ^TMP($J,"PSOAPT",2,1)="No Known Allergies" K ^TMP($J,"PSOAPT",3)
- S CCC=1,OUT=0
- F S CCC=$O(^TMP($J,"PSOAPT",CCC)) Q:CCC="" D Q:OUT
- .S TEXT=$G(^TMP($J,"PSOAPT",CCC))
- .I $G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT)
- .S PSOY=PSOY+PSOYI D PRINT(TEXT,0,1)
- .I TEXT="No Assessment Made" Q
- .I PSOY>PSOYM S OUT=1 Q
- .S (TEXT,PTEXT,CCC2)="",LENGTH=0
- .F S CCC2=$O(^TMP($J,"PSOAPT",CCC,CCC2)) Q:CCC2="" S TEXT=^(CCC2) D Q:OUT
- ..D STRT^PSOLLU1("SEC2",TEXT,.L)
- ..I LENGTH+L(XFONT)<3.7 S PTEXT=PTEXT_TEXT_",",LENGTH=LENGTH+L(XFONT) Q
- ..I PTEXT="" D Q
- ... F JJ=$L(TEXT):-1 S PTEXT=$E(TEXT,1,JJ) D STRT^PSOLLU1("SEC2",PTEXT,.L) I L(XFONT)<3.7 D PRINT(PTEXT,0) S PTEXT=$E(TEXT,JJ+1,512)_"," Q
- ... D STRT^PSOLLU1("SEC2",PTEXT,.L) S LENGTH=L(XFONT)
- ..S LENGTH=0,CCC2=CCC2-1
- ..I PSOY>PSOYM S OUT=1 Q
- ..D PRINT(PTEXT,0) S PTEXT=""
- .I 'OUT,PTEXT]"" D PRINT($P(PTEXT,",",1,$L(PTEXT,",")-1),0)
- I OUT S T="Additional Allergies or Adverse Reactions Exist." D PRINT(T,0) S T="Talk to your Physician or Pharmacist." D PRINT(T,0)
- K ^TMP($J,"PSOALWA"),^TMP($J,"PSOAPT"),PSONKA,PSONULL,WWW,GMRA,GMRAL,JJJ,WCNT,RRR,ALG,ALCNT,EEE,FFF,PSOLG,PSOLGA,PSORY,CCC,CCC2,FNTFLG,TEXT,TEXT2
- Q
- PRINT(T,B,UL) ;
- S BOLD=$G(B),UL=$G(UL)
- I 'BOLD,$G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT)
- I BOLD,$G(PSOIO(PSOFONT_"B"))]"" X PSOIO(PSOFONT_"B")
- I $G(PSOIO("ST"))]"" X PSOIO("ST")
- I UL,$G(PSOIO("FWU"))]"" X PSOIO("FWU")
- W T,!
- I UL,$G(PSOIO("FDU"))]"" X PSOIO("FDU")
- I $G(PSOIO("ET"))]"" X PSOIO("ET")
- I BOLD,$G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT) ;TURN OFF BOLDING
- Q
- ASSESS ;
- N FLG3,FLG4,FLG5
- S CCC=$G(^TMP($J,"PSOAPT",2,1))
- S FLG3=$G(^TMP($J,"PSOAPT",3,1))
- S FLG4=$G(^TMP($J,"PSOAPT",4,1))
- S FLG5=$G(^TMP($J,"PSOAPT",5,1))
- I CCC="",FLG3="",FLG4="",FLG5="" S ^TMP($J,"PSOAPT",2,1)="No Assessment Made" K ^TMP($J,"PSOAPT",3)
- Q
- MAIL ;PRINT MAILING ADHESIVE LABEL
- ;S PS=$S($D(^PS(59,PSOSITE,0)):^(0),1:"")
- ;I $P(PSOSYS,"^",4),$D(^PS(59,+$P($G(PSOSYS),"^",4),0)) S PS=^PS(59,$P($G(PSOSYS),"^",4),0)
- S VAADDR1=$P(HINFO,"^"),VASTREET=$P($P(HINFO,"^",2),"~"),STATE=$S($P($P(HINFO,"^",2),"~",4)]"":$P($P(HINFO,"^",2),"~",4),1:"UNKNOWN")
- S PSZIP=$P($P($P(HINFO,"^",2),"~",5),"&"),PSOHZIP=$S(PSZIP["-":PSZIP,1:$E(PSZIP,1,5)_$S($E(PSZIP,6,9)]"":"-"_$E(PSZIP,6,9),1:""))
- I $G(PSOIO("MLI"))]"" X PSOIO("MLI")
- I $G(PSOIO("PSOFONT"))]"" X PSOIO("PSOFONT")
- S TEXT="Attn: (119)" D PRINT(TEXT)
- S TEXT=VAADDR1 D PRINT(TEXT)
- S TEXT=$G(VASTREET) D PRINT(TEXT)
- S TEXT=$P($P(HINFO,"^",2),"~",3)_", "_$G(STATE)_" "_$G(PSOHZIP) D PRINT(TEXT)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSORLLL5 5717 printed Feb 19, 2025@00:00:23 Page 2
- PSORLLL5 ;AITC/BWF - LASER LABEL CONTINUED ;11/14/05 10:09am
- +1 ;;7.0;OUTPATIENT PHARMACY;**454**;DEC 1997;Build 349
- +2 ; BWF - OneVa Pharmacy modified copy of PSOLLL5
- +3 ;
- START ;
- +1 NEW TEXT,BLNKLIN
- +2 SET $PIECE(BLNKLIN,"_",90)="_"
- +3 DO MAIL
- +4 IF $GET(PSOIO("ACI"))]""
- XECUTE PSOIO("ACI")
- +5 SET TEXT="HAS YOUR ADDRESS CHANGED?"
- DO STRT^PSOLLU1("SEC2",TEXT,.L)
- +6 SET OPSOX=PSOX
- SET PSOX=4.2-L($EXTRACT(PSOHFONT,2,99))*300/2+OPSOX
- +7 SET OFONT=PSOFONT
- SET PSOFONT=$GET(PSOHFONT,OFONT)
- DO PRINT(TEXT,1)
- SET PSOX=OPSOX
- SET PSOY=PSOY+10
- SET PSOFONT=OFONT
- +8 SET TEXT="Write address changes in the blanks, sign the form, and return to"
- DO PRINT(TEXT,0)
- +9 SET TEXT="your pharmacy."
- DO PRINT(TEXT,0)
- +10 SET X=$SELECT($DATA(^DPT(DFN,0))#2:^(0),1:"")
- SET PNM=$PIECE(X,"^")
- +11 DO PID^VADPT6
- DO ADD^VADPT
- SET SSNP=""
- +12 SET PSOY=PSOY+PSOYI
- SET TEXT=PNM_" "_SSNP
- DO PRINT(TEXT,0)
- +13 IF $GET(VAPA(1))=""
- GOTO ALLERGY
- +14 FOR I=1:1:3
- IF $GET(VAPA(I))]""
- SET TEXT=$GET(VAPA(I))_$EXTRACT(BLNKLIN,1,80-$LENGTH(VAPA(I)))
- DO PRINT(TEXT,0)
- +15 SET A=+$GET(VAPA(5))
- IF A
- SET A=$SELECT($DATA(^DIC(5,A,0)):$PIECE(^(0),"^",2),1:"UNKNOWN")
- +16 SET B=$GET(VAPA(4))_", "_A_" "_$SELECT($GET(VAPA(11)):$PIECE(VAPA(11),"^",2),1:$GET(VAPA(6)))
- +17 SET TEXT=B_$EXTRACT(BLNKLIN,1,80-$LENGTH(B))
- DO PRINT(TEXT,0)
- +18 SET B=VAPA(8)
- +19 SET TEXT=B_$EXTRACT(BLNKLIN,1,80-$LENGTH(B))
- DO PRINT(TEXT,0)
- +20 if $GET(VAPA(3))=""
- SET PSOY=PSOY+PSOYI
- +21 SET TEXT="[ ] Permanent [ ] Temporary until ____/____/____"
- DO PRINT(TEXT,0)
- +22 SET PSOY=$GET(PSOFY)
- SET TEXT="Signature "_$EXTRACT(BLNKLIN,1,45)
- DO PRINT(TEXT,0)
- +23 ;
- ALLERGY ;ALLERGIES & REACTIONS
- +1 KILL ^TMP($JOB,"PSOALWA")
- +2 SET GMRA="0^0^111"
- DO ^GMRADPT
- +3 IF $GET(GMRAL)
- SET PSORY=0
- FOR
- SET PSORY=$ORDER(GMRAL(PSORY))
- if 'PSORY
- QUIT
- SET ^TMP($JOB,"PSOALWA",$SELECT($PIECE(GMRAL(PSORY),"^",4):1,1:2),$SELECT('$PIECE(GMRAL(PSORY),"^",5):1,1:2),$PIECE(GMRAL(PSORY),"^",7),$PIECE(GMRAL(PSORY),"^",2))=""
- +4 SET ^TMP($JOB,"PSOAPT",1)=$GET(PNM)_" "_$GET(SSNP)
- SET ^(2)="Verified Allergies"
- +5 SET ALCNT=0
- SET EEE=0
- SET (PSOLG,PSOLGA)=""
- FOR
- SET PSOLG=$ORDER(^TMP($JOB,"PSOALWA",1,1,PSOLG))
- if PSOLG=""
- QUIT
- FOR
- SET PSOLGA=$ORDER(^TMP($JOB,"PSOALWA",1,1,PSOLG,PSOLGA))
- if PSOLGA=""
- QUIT
- SET EEE=1
- SET ALCNT=ALCNT+1
- SET ^TMP($JOB,"PSOAPT",2,ALCNT)=PSOLGA
- +6 IF 'EEE
- IF $GET(GMRAL)=0
- SET ALCNT=ALCNT+1
- SET ^TMP($JOB,"PSOAPT",2,ALCNT)="NKA"
- +7 SET ALCNT=0
- SET ^TMP($JOB,"PSOAPT",3)="Non-Verified Allergies"
- +8 SET EEE=0
- SET (PSOLG,PSOLGA)=""
- FOR
- SET PSOLG=$ORDER(^TMP($JOB,"PSOALWA",2,1,PSOLG))
- if PSOLG=""
- QUIT
- FOR
- SET PSOLGA=$ORDER(^TMP($JOB,"PSOALWA",2,1,PSOLG,PSOLGA))
- if PSOLGA=""
- QUIT
- SET EEE=EEE+1
- SET ALCNT=ALCNT+1
- SET ^TMP($JOB,"PSOAPT",3,ALCNT)=PSOLGA
- +9 IF 'EEE
- IF $GET(GMRAL)=0
- SET ALCNT=ALCNT+1
- SET ^TMP($JOB,"PSOAPT",3,ALCNT)="NKA"
- +10 SET ALCNT=0
- SET ^TMP($JOB,"PSOAPT",4)="Verified Adverse Reactions"
- +11 SET (PSOLG,PSOLGA)=""
- FOR
- SET PSOLG=$ORDER(^TMP($JOB,"PSOALWA",1,2,PSOLG))
- if PSOLG=""
- QUIT
- FOR
- SET PSOLGA=$ORDER(^TMP($JOB,"PSOALWA",1,2,PSOLG,PSOLGA))
- if PSOLGA=""
- QUIT
- SET ALCNT=ALCNT+1
- SET ^TMP($JOB,"PSOAPT",4,ALCNT)=PSOLGA
- +12 SET ALCNT=0
- SET ^TMP($JOB,"PSOAPT",5)="Non-Verified Adverse Reactions"
- +13 SET (PSOLG,PSOLGA)=""
- FOR
- SET PSOLG=$ORDER(^TMP($JOB,"PSOALWA",2,2,PSOLG))
- if PSOLG=""
- QUIT
- FOR
- SET PSOLGA=$ORDER(^TMP($JOB,"PSOALWA",2,2,PSOLG,PSOLGA))
- if PSOLGA=""
- QUIT
- SET ALCNT=ALCNT+1
- SET ^TMP($JOB,"PSOAPT",5,ALCNT)=PSOLGA
- +14 IF $GET(PSOIO("ALI"))]""
- XECUTE PSOIO("ALI")
- +15 SET XFONT=$EXTRACT($GET(PSOFONT),2,99)
- +16 SET OFONT=PSOFONT
- SET PSOFONT=$GET(PSOHFONT,PSOFONT)
- SET TEXT=^TMP($JOB,"PSOAPT",1)
- DO PRINT(TEXT,1)
- SET PSOFONT=OFONT
- +17 SET TEXT=""
- DO PRINT(TEXT,0)
- +18 FOR CCC=3,4,5
- IF '$ORDER(^TMP($JOB,"PSOAPT",CCC,0))
- KILL ^TMP($JOB,"PSOAPT",CCC)
- +19 DO ASSESS
- +20 IF CCC="NKA"
- SET ^TMP($JOB,"PSOAPT",2,1)="No Known Allergies"
- KILL ^TMP($JOB,"PSOAPT",3)
- +21 SET CCC=1
- SET OUT=0
- +22 FOR
- SET CCC=$ORDER(^TMP($JOB,"PSOAPT",CCC))
- if CCC=""
- QUIT
- Begin DoDot:1
- +23 SET TEXT=$GET(^TMP($JOB,"PSOAPT",CCC))
- +24 IF $GET(PSOIO(PSOFONT))]""
- XECUTE PSOIO(PSOFONT)
- +25 SET PSOY=PSOY+PSOYI
- DO PRINT(TEXT,0,1)
- +26 IF TEXT="No Assessment Made"
- QUIT
- +27 IF PSOY>PSOYM
- SET OUT=1
- QUIT
- +28 SET (TEXT,PTEXT,CCC2)=""
- SET LENGTH=0
- +29 FOR
- SET CCC2=$ORDER(^TMP($JOB,"PSOAPT",CCC,CCC2))
- if CCC2=""
- QUIT
- SET TEXT=^(CCC2)
- Begin DoDot:2
- +30 DO STRT^PSOLLU1("SEC2",TEXT,.L)
- +31 IF LENGTH+L(XFONT)<3.7
- SET PTEXT=PTEXT_TEXT_","
- SET LENGTH=LENGTH+L(XFONT)
- QUIT
- +32 IF PTEXT=""
- Begin DoDot:3
- +33 FOR JJ=$LENGTH(TEXT):-1
- SET PTEXT=$EXTRACT(TEXT,1,JJ)
- DO STRT^PSOLLU1("SEC2",PTEXT,.L)
- IF L(XFONT)<3.7
- DO PRINT(PTEXT,0)
- SET PTEXT=$EXTRACT(TEXT,JJ+1,512)_","
- QUIT
- +34 DO STRT^PSOLLU1("SEC2",PTEXT,.L)
- SET LENGTH=L(XFONT)
- End DoDot:3
- QUIT
- +35 SET LENGTH=0
- SET CCC2=CCC2-1
- +36 IF PSOY>PSOYM
- SET OUT=1
- QUIT
- +37 DO PRINT(PTEXT,0)
- SET PTEXT=""
- End DoDot:2
- if OUT
- QUIT
- +38 IF 'OUT
- IF PTEXT]""
- DO PRINT($PIECE(PTEXT,",",1,$LENGTH(PTEXT,",")-1),0)
- End DoDot:1
- if OUT
- QUIT
- +39 IF OUT
- SET T="Additional Allergies or Adverse Reactions Exist."
- DO PRINT(T,0)
- SET T="Talk to your Physician or Pharmacist."
- DO PRINT(T,0)
- +40 KILL ^TMP($JOB,"PSOALWA"),^TMP($JOB,"PSOAPT"),PSONKA,PSONULL,WWW,GMRA,GMRAL,JJJ,WCNT,RRR,ALG,ALCNT,EEE,FFF,PSOLG,PSOLGA,PSORY,CCC,CCC2,FNTFLG,TEXT,TEXT2
- +41 QUIT
- PRINT(T,B,UL) ;
- +1 SET BOLD=$GET(B)
- SET UL=$GET(UL)
- +2 IF 'BOLD
- IF $GET(PSOIO(PSOFONT))]""
- XECUTE PSOIO(PSOFONT)
- +3 IF BOLD
- IF $GET(PSOIO(PSOFONT_"B"))]""
- XECUTE PSOIO(PSOFONT_"B")
- +4 IF $GET(PSOIO("ST"))]""
- XECUTE PSOIO("ST")
- +5 IF UL
- IF $GET(PSOIO("FWU"))]""
- XECUTE PSOIO("FWU")
- +6 WRITE T,!
- +7 IF UL
- IF $GET(PSOIO("FDU"))]""
- XECUTE PSOIO("FDU")
- +8 IF $GET(PSOIO("ET"))]""
- XECUTE PSOIO("ET")
- +9 ;TURN OFF BOLDING
- IF BOLD
- IF $GET(PSOIO(PSOFONT))]""
- XECUTE PSOIO(PSOFONT)
- +10 QUIT
- ASSESS ;
- +1 NEW FLG3,FLG4,FLG5
- +2 SET CCC=$GET(^TMP($JOB,"PSOAPT",2,1))
- +3 SET FLG3=$GET(^TMP($JOB,"PSOAPT",3,1))
- +4 SET FLG4=$GET(^TMP($JOB,"PSOAPT",4,1))
- +5 SET FLG5=$GET(^TMP($JOB,"PSOAPT",5,1))
- +6 IF CCC=""
- IF FLG3=""
- IF FLG4=""
- IF FLG5=""
- SET ^TMP($JOB,"PSOAPT",2,1)="No Assessment Made"
- KILL ^TMP($JOB,"PSOAPT",3)
- +7 QUIT
- MAIL ;PRINT MAILING ADHESIVE LABEL
- +1 ;S PS=$S($D(^PS(59,PSOSITE,0)):^(0),1:"")
- +2 ;I $P(PSOSYS,"^",4),$D(^PS(59,+$P($G(PSOSYS),"^",4),0)) S PS=^PS(59,$P($G(PSOSYS),"^",4),0)
- +3 SET VAADDR1=$PIECE(HINFO,"^")
- SET VASTREET=$PIECE($PIECE(HINFO,"^",2),"~")
- SET STATE=$SELECT($PIECE($PIECE(HINFO,"^",2),"~",4)]"":$PIECE($PIECE(HINFO,"^",2),"~",4),1:"UNKNOWN")
- +4 SET PSZIP=$PIECE($PIECE($PIECE(HINFO,"^",2),"~",5),"&")
- SET PSOHZIP=$SELECT(PSZIP["-":PSZIP,1:$EXTRACT(PSZIP,1,5)_$SELECT($EXTRACT(PSZIP,6,9)]"":"-"_$EXTRACT(PSZIP,6,9),1:""))
- +5 IF $GET(PSOIO("MLI"))]""
- XECUTE PSOIO("MLI")
- +6 IF $GET(PSOIO("PSOFONT"))]""
- XECUTE PSOIO("PSOFONT")
- +7 SET TEXT="Attn: (119)"
- DO PRINT(TEXT)
- +8 SET TEXT=VAADDR1
- DO PRINT(TEXT)
- +9 SET TEXT=$GET(VASTREET)
- DO PRINT(TEXT)
- +10 SET TEXT=$PIECE($PIECE(HINFO,"^",2),"~",3)_", "_$GET(STATE)_" "_$GET(PSOHZIP)
- DO PRINT(TEXT)
- +11 QUIT