PSOLLL5 ;BIR/RJS - LASER LABEL CONTINUED ;14-Jun-2013 09:26;PLS
;;7.0;OUTPATIENT PHARMACY;**120,161,230,200,326,1015**;DEC 1997;Build 62
;
; Modified - IHS/CIA/PLS - 03/06/04
START ;
N TEXT,BLNKLIN
S $P(BLNKLIN,"_",90)="_"
D MAIL^PSOLLL7
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,"^")
; IHS/CIA/PLS - 03/06/04 - Set to full HRN
;D PID^VADPT6,ADD^VADPT S SSNP=""
D PID^VADPT6,ADD^VADPT S SSNP=VA("PID")
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
I $$GET1^DIQ(44,$P(RXY,"^",5),2,"I")="W" S TEXT="INPATIENT" 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
SUSPEN S PSODFN=DFN,(SPPL,RXX,STA)="",XXS=1
I $G(PSODTCUT)']"" S X1=DT,X2=-120 D C^%DTC S PSODTCUT=X
D ^PSOBUILD S (STA,RXX)=""
F S STA=$O(PSOSD(STA)) Q:STA="" F S RXX=$O(PSOSD(STA,RXX)) Q:RXX="" I $P(PSOSD(STA,RXX),"^",2)=5 S SPPL=$P(PSOSD(STA,RXX),"^")_","_SPPL
I SPPL="" Q
SUSP1 I $G(PSOIO("SPI"))]"" X PSOIO("SPI")
S TOF=0,TEXT=PNM_" "_SSNP_" "_$G(PSONOW) D PRINT(TEXT,0)
S TEXT="The following prescription(s) have been requested and will be" D PRINT(TEXT,0)
S TEXT="mailed to you on or after the date indicated." D PRINT(TEXT,0)
S PSOY=PSOY+PSOYI,TEXT="Rx# Date "
D PRINT(TEXT,0,1)
F XX=XXS:1 Q:$P(SPPL,",",XX)="" S RX=$P(SPPL,",",XX) D Q:TOF
. S SPNUM=$O(^PS(52.5,"B",RX,0)) I SPNUM S SPDATE=$P($G(^PS(52.5,SPNUM,0)),"^",2) S Y=SPDATE X ^DD("DD") S SPDATE=Y
. S T=$P(^PSRX(RX,0),"^") D PRINT(T,0)
. S PSOY=PSOY-PSOYI,OPSOX=PSOX,PSOX=PSOCX,T=$G(SPDATE) D PRINT(T,0)
. S PSOX=OPSOX+20,T=$$ZZ^PSOSUTL(RX) D PRINT(T,0) K SPNUM,SPDATE,Y,ZDRUG
. S PSOX=OPSOX,PSOY=PSOY+PSOYI
. I PSOY>PSOYM S XXS=XX+1,TOF=1 W:$P(SPPL,",",XXS)]"" @IOF Q
I TOF,$P(SPPL,",",XXS)]"" G SUSP1
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
PSOLLL5 ;BIR/RJS - LASER LABEL CONTINUED ;14-Jun-2013 09:26;PLS
+1 ;;7.0;OUTPATIENT PHARMACY;**120,161,230,200,326,1015**;DEC 1997;Build 62
+2 ;
+3 ; Modified - IHS/CIA/PLS - 03/06/04
START ;
+1 NEW TEXT,BLNKLIN
+2 SET $PIECE(BLNKLIN,"_",90)="_"
+3 DO MAIL^PSOLLL7
+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 ; IHS/CIA/PLS - 03/06/04 - Set to full HRN
+12 ;D PID^VADPT6,ADD^VADPT S SSNP=""
+13 DO PID^VADPT6
DO ADD^VADPT
SET SSNP=VA("PID")
+14 SET PSOY=PSOY+PSOYI
SET TEXT=PNM_" "_SSNP
DO PRINT(TEXT,0)
+15 IF $GET(VAPA(1))=""
GOTO ALLERGY
+16 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)
+17 SET A=+$GET(VAPA(5))
IF A
SET A=$SELECT($DATA(^DIC(5,A,0)):$PIECE(^(0),"^",2),1:"UNKNOWN")
+18 SET B=$GET(VAPA(4))_", "_A_" "_$SELECT($GET(VAPA(11)):$PIECE(VAPA(11),"^",2),1:$GET(VAPA(6)))
+19 SET TEXT=B_$EXTRACT(BLNKLIN,1,80-$LENGTH(B))
DO PRINT(TEXT,0)
+20 SET B=VAPA(8)
+21 SET TEXT=B_$EXTRACT(BLNKLIN,1,80-$LENGTH(B))
DO PRINT(TEXT,0)
+22 IF $GET(VAPA(3))=""
SET PSOY=PSOY+PSOYI
+23 SET TEXT="[ ] Permanent [ ] Temporary until ____/____/____"
DO PRINT(TEXT,0)
+24 SET PSOY=$GET(PSOFY)
SET TEXT="Signature "_$EXTRACT(BLNKLIN,1,45)
DO PRINT(TEXT,0)
+25 ;
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 IF $$GET1^DIQ(44,$PIECE(RXY,"^",5),2,"I")="W"
SET TEXT="INPATIENT"
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
SUSPEN SET PSODFN=DFN
SET (SPPL,RXX,STA)=""
SET XXS=1
+1 IF $GET(PSODTCUT)']""
SET X1=DT
SET X2=-120
DO C^%DTC
SET PSODTCUT=X
+2 DO ^PSOBUILD
SET (STA,RXX)=""
+3 FOR
SET STA=$ORDER(PSOSD(STA))
IF STA=""
QUIT
FOR
SET RXX=$ORDER(PSOSD(STA,RXX))
IF RXX=""
QUIT
IF $PIECE(PSOSD(STA,RXX),"^",2)=5
SET SPPL=$PIECE(PSOSD(STA,RXX),"^")_","_SPPL
+4 IF SPPL=""
QUIT
SUSP1 IF $GET(PSOIO("SPI"))]""
XECUTE PSOIO("SPI")
+1 SET TOF=0
SET TEXT=PNM_" "_SSNP_" "_$GET(PSONOW)
DO PRINT(TEXT,0)
+2 SET TEXT="The following prescription(s) have been requested and will be"
DO PRINT(TEXT,0)
+3 SET TEXT="mailed to you on or after the date indicated."
DO PRINT(TEXT,0)
+4 SET PSOY=PSOY+PSOYI
SET TEXT="Rx# Date "
+5 DO PRINT(TEXT,0,1)
+6 FOR XX=XXS:1
IF $PIECE(SPPL,",",XX)=""
QUIT
SET RX=$PIECE(SPPL,",",XX)
Begin DoDot:1
+7 SET SPNUM=$ORDER(^PS(52.5,"B",RX,0))
IF SPNUM
SET SPDATE=$PIECE($GET(^PS(52.5,SPNUM,0)),"^",2)
SET Y=SPDATE
XECUTE ^DD("DD")
SET SPDATE=Y
+8 SET T=$PIECE(^PSRX(RX,0),"^")
DO PRINT(T,0)
+9 SET PSOY=PSOY-PSOYI
SET OPSOX=PSOX
SET PSOX=PSOCX
SET T=$GET(SPDATE)
DO PRINT(T,0)
+10 SET PSOX=OPSOX+20
SET T=$$ZZ^PSOSUTL(RX)
DO PRINT(T,0)
KILL SPNUM,SPDATE,Y,ZDRUG
+11 SET PSOX=OPSOX
SET PSOY=PSOY+PSOYI
+12 IF PSOY>PSOYM
SET XXS=XX+1
SET TOF=1
IF $PIECE(SPPL,",",XXS)]""
WRITE @IOF
QUIT
End DoDot:1
IF TOF
QUIT
+13 IF TOF
IF $PIECE(SPPL,",",XXS)]""
GOTO SUSP1
+14 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
