PSOLBLN1 ;BIR/BHW - NEW LABEL CONTINUED ;03/14/94
;;7.0;OUTPATIENT PHARMACY;**5,30,71,107,110,162,367,383**;DEC 1997;Build 6
;External reference to ^PS(54 supported by DBIA 2227
START W !,?54,$S($L($G(COPAYVAR)):$G(COPAYVAR)_" ",1:""),"Days Supply: ",$G(DAYS),?102,"Mfg "_$G(MFG)_" Lot# "_$G(LOT)
I 'PRTFL G NORENW
;NO REFILLS
W !,$P(PS,"^",2),?102,"Tech__________RPh__________"
W !,$P(PS,"^",7),", ",STATE," ",$G(PSOHZIP)
I $G(PSOBARS),$P(PSOPAR,"^",19)'=1 S X="S",X2=PSOINST_"-"_RX S X1=$X W ?54,@PSOBAR1,X2,@PSOBAR0,$C(13) S $X=0
E W !!!!
W "ADDRESS SERVICE REQUESTED",?54,"* NO REFILLS REMAINING ** PHYSICIAN USE ONLY *"
;
; Printing FDA Medication Guide (if there's one)
I $$MGONFILE^PSOFDAUT(RX) D
. W ?102,"Read FDA Med Guide"
. I $G(REPRINT),'$D(RXRP(RX,"MG")) Q
. N FDAMG S FDAMG=$$PRINTMG^PSOFDAMG(RX,$P($G(PSOFDAPT),"^",2))
;
W ! W:"C"[$E(MW) ?21,"CERTIFIED MAIL" W ?54,"*Signature:____________________________SC NSC*"
W !,?54,"*Print Name:",ULN,"*",! W $S($G(PS55)=2:"***DO NOT MAIL***",1:"***CRITICAL MEDICAL SHIPMENT***") W ?54,"*DEA or VA#_________________Date_____________*",?102,"Routing: "_$S("W"[$E(MW):MW,1:MW_" MAIL")
W !,?54,"*Refills: 0 1 2 3 4 5 6 7 8 9 10 11",?99,"*",?102,"Days Supply: ",$G(DAYS)," Cap: ",$S(PSCAP:"**NON-SFTY**",1:"SAFETY")
W !,?54,"***** To be filled in VA Pharmacies only *****",?102,"Isd: ",ISD," Exp: ",EXPDT,!,PNM,?54,$G(VAPA(1)),?102,"Last Fill: ",$G(PSOLASTF)
W !,$S($D(PSMP(1)):PSMP(1),1:VAPA(1)),?54,$G(ADDR(2)),?102,"Pat. Stat ",PATST," Clinic: ",PSCLN
W !,$S($D(PSMP(2)):PSMP(2),$D(PSMP(1)):"",1:$G(ADDR(2))),?54,$G(ADDR(3)),?102,$S($G(WARN)'="":"DRUG WARNING "_$G(WARN),1:"")
W !,$S($D(PSMP(3)):PSMP(3),$D(PSMP(1)):"",1:$G(ADDR(3))),?54,$G(ADDR(4))
W !,$S($D(PSMP(4)):PSMP(4),$D(PSMP(1)):"",1:$G(ADDR(4))),?54,"*Indicate address change on back of this form",!,?54,"[ ] Permanent [ ] Temporary until ",$S($P($G(VAPA(10)),"^",2)]"":$P($G(VAPA(10)),"^",2),1:"__/__/__")
I $G(PSOBARS) S X="S",X2=PSOINST_"-"_RX S X1=$X W ?102,@PSOBAR1,X2,@PSOBAR0,$C(13) S $X=0
Q
NORENW ;NO RENEW
W !,$P(PS,"^",2),?102,"Tech__________RPH__________"
W !,$P(PS,"^",7),", ",STATE," ",$G(PSOHZIP)
I $G(PSOBARS),$P(PSOPAR,"^",19)'=1 S X="S",X2=PSOINST_"-"_RX S X1=$X W ?54,@PSOBAR1,X2,@PSOBAR0,$C(13) S $X=0
E W !!!!
W "ADDRESS SERVICE REQUESTED",?54,"*** This prescription CANNOT be renewed ***",! W:"C"[$E(MW) ?21,"CERTIFIED MAIL" W ?54,"*",?96,"*",!,?54,"* A NEW PRESCRIPTION IS REQUIRED *"
W !,$S($G(PS55)=2:"***DO NOT MAIL***",1:"***CRITICAL MEDICAL SHIPMENT***"),?54,"*",?96,"*",!,?54,"***** Please contact your physician *******"
W !,?54,$G(VAPA(1)),?102,"Routing: "_$S("W"[$E(MW):MW,1:MW_" MAIL"),!,?54,$G(ADDR(2)),?102,"Days supply: ",$G(DAYS)," Cap: ",$S(PSCAP:"**NON-SFTY**",1:"SAFETY")
W !,PNM,?54,$G(ADDR(3)),?102,"Isd: ",ISD," Exp: ",EXPDT
W !,$S($D(PSMP(1)):PSMP(1),1:VAPA(1)),?54,$G(ADDR(4)),?102,"Last Fill: ",$G(PSOLASTF)
W !,$S($D(PSMP(2)):PSMP(2),$D(PSMP(1)):"",1:$G(ADDR(2))),?54,"*Indicate address change on back of this form",?102,"Pat. Stat ",PATST," Clinic: ",PSCLN
W !,$S($D(PSMP(3)):PSMP(3),$D(PSMP(1)):"",1:$G(ADDR(3))),?54,"[ ] Permanent [ ] Temporary until ",$S($P($G(VAPA(10)),"^",2)]"":$P($G(VAPA(10)),"^",2),1:"__/__/__"),?102,$S($G(WARN)'="":"DRUG WARNING "_$G(WARN),1:"")
W !,$S($D(PSMP(4)):PSMP(4),$D(PSMP(1)):"",1:$G(ADDR(4))) I $G(PSOBARS) S X="S",X2=PSOINST_"-"_RX S X1=$X W ?102,@PSOBAR1,X2,@PSOBAR0,$C(13) S $X=0
Q
ALLWARN ;ALLERGIES WITH DRUG WARNING
I $G(PSOBLALL),$P(PPL,",",PI+1)'="" D WARN^PSOLBL2 Q
K ^TMP($J,"PSOWARN"),^TMP($J,"PSOWPT"),^TMP($J,"PSOAPT"),PSONKA,PSONULL
X "N X S X=""GMRADPT"" X ^%ZOSF(""TEST"") Q" I '$T D WARN^PSOLBL2 Q
F WWW=1:1 Q:$P(WARN,",",WWW,99)="" S PSOWARN=$P(WARN,",",WWW) D:$D(^PS(54,PSOWARN,0))
. ;BHW;Modify Loop to use $O instead of 1:1
. S JJJ=0
. F S JJJ=$O(^PS(54,PSOWARN,1,JJJ)) Q:('JJJ) D
. . I $D(^PS(54,PSOWARN,1,JJJ,0)) S ^TMP($J,"PSOWARN",PSOWARN,JJJ)=^PS(54,PSOWARN,1,JJJ,0)
. . Q
. Q
S ^TMP($J,"PSOWPT",1)=PNM,^(2)="Rx# "_RXN,^(3)=DRUG,^(4)="DRUG WARNING:"
S WCNT=4 F WWW=0:0 S WWW=$O(^TMP($J,"PSOWARN",WWW)) Q:'WWW F RRR=0:0 S RRR=$O(^TMP($J,"PSOWARN",WWW,RRR)) Q:'RRR S WCNT=WCNT+1 S ^TMP($J,"PSOWPT",WCNT)=^TMP($J,"PSOWARN",WWW,RRR)
K ^TMP($J,"ALWA")
S GMRA="0^0^111" D ^GMRADPT I $G(GMRAL) F PSORY=0:0 S PSORY=$O(GMRAL(PSORY)) Q:'PSORY S ^TMP($J,"ALWA",$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)="",^(3)="Verified Allergies",^(4)="------------------"
S ALCNT=4,EEE=0,(PSOLG,PSOLGA)="" F S PSOLG=$O(^TMP($J,"ALWA",1,1,PSOLG)) Q:PSOLG="" F S PSOLGA=$O(^TMP($J,"ALWA",1,1,PSOLG,PSOLGA)) Q:PSOLGA="" S EEE=1,ALCNT=ALCNT+1,^TMP($J,"PSOAPT",ALCNT)=" "_PSOLGA
I EEE S ALCNT=ALCNT+1,^TMP($J,"PSOAPT",ALCNT)=""
I 'EEE D
.I $G(GMRAL)=0 S ALCNT=ALCNT+1,^TMP($J,"PSOAPT",ALCNT)=" "_"NKA",ALCNT=ALCNT+1,^TMP($J,"PSOAPT",ALCNT)=""
.E S ALCNT=ALCNT+1,^TMP($J,"PSOAPT",ALCNT)=""
S ALCNT=ALCNT+1,^TMP($J,"PSOAPT",ALCNT)="Non-Verified Allergies",ALCNT=ALCNT+1,^TMP($J,"PSOAPT",ALCNT)="----------------------"
S EEE=0,(PSOLG,PSOLGA)="" F S PSOLG=$O(^TMP($J,"ALWA",2,1,PSOLG)) Q:PSOLG="" F S PSOLGA=$O(^TMP($J,"ALWA",2,1,PSOLG,PSOLGA)) Q:PSOLGA="" S EEE=EEE+1,ALCNT=ALCNT+1,^TMP($J,"PSOAPT",ALCNT)=" "_PSOLGA
I EEE S ALCNT=ALCNT+1,^TMP($J,"PSOAPT",ALCNT)=""
I 'EEE D
.I $G(GMRAL)=0 S ALCNT=ALCNT+1,^TMP($J,"PSOAPT",ALCNT)=" "_"NKA",ALCNT=ALCNT+1,^TMP($J,"PSOAPT",ALCNT)=""
.E S ALCNT=ALCNT+1,^TMP($J,"PSOAPT",ALCNT)=""
S ALCNT=ALCNT+1,^TMP($J,"PSOAPT",ALCNT)="Verified Adverse Reactions",ALCNT=ALCNT+1,^TMP($J,"PSOAPT",ALCNT)="--------------------------"
S (PSOLG,PSOLGA)="" F S PSOLG=$O(^TMP($J,"ALWA",1,2,PSOLG)) Q:PSOLG="" F S PSOLGA=$O(^TMP($J,"ALWA",1,2,PSOLG,PSOLGA)) Q:PSOLGA="" S ALCNT=ALCNT+1,^TMP($J,"PSOAPT",ALCNT)=" "_PSOLGA
S ALCNT=ALCNT+1,^TMP($J,"PSOAPT",ALCNT)="",ALCNT=ALCNT+1,^TMP($J,"PSOAPT",ALCNT)="Non-Verified Adverse Reactions",ALCNT=ALCNT+1,^TMP($J,"PSOAPT",ALCNT)="------------------------------"
S (PSOLG,PSOLGA)="" F S PSOLG=$O(^TMP($J,"ALWA",2,2,PSOLG)) Q:PSOLG="" F S PSOLGA=$O(^TMP($J,"ALWA",2,2,PSOLG,PSOLGA)) Q:PSOLGA="" S ALCNT=ALCNT+1,^TMP($J,"PSOAPT",ALCNT)=" "_PSOLGA
PRT D PRINT^PSOLBL2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOLBLN1 6347 printed Dec 13, 2024@02:30:28 Page 2
PSOLBLN1 ;BIR/BHW - NEW LABEL CONTINUED ;03/14/94
+1 ;;7.0;OUTPATIENT PHARMACY;**5,30,71,107,110,162,367,383**;DEC 1997;Build 6
+2 ;External reference to ^PS(54 supported by DBIA 2227
START WRITE !,?54,$SELECT($LENGTH($GET(COPAYVAR)):$GET(COPAYVAR)_" ",1:""),"Days Supply: ",$GET(DAYS),?102,"Mfg "_$GET(MFG)_" Lot# "_$GET(LOT)
+1 IF 'PRTFL
GOTO NORENW
+2 ;NO REFILLS
+3 WRITE !,$PIECE(PS,"^",2),?102,"Tech__________RPh__________"
+4 WRITE !,$PIECE(PS,"^",7),", ",STATE," ",$GET(PSOHZIP)
+5 IF $GET(PSOBARS)
IF $PIECE(PSOPAR,"^",19)'=1
SET X="S"
SET X2=PSOINST_"-"_RX
SET X1=$X
WRITE ?54,@PSOBAR1,X2,@PSOBAR0,$CHAR(13)
SET $X=0
+6 IF '$TEST
WRITE !!!!
+7 WRITE "ADDRESS SERVICE REQUESTED",?54,"* NO REFILLS REMAINING ** PHYSICIAN USE ONLY *"
+8 ;
+9 ; Printing FDA Medication Guide (if there's one)
+10 IF $$MGONFILE^PSOFDAUT(RX)
Begin DoDot:1
+11 WRITE ?102,"Read FDA Med Guide"
+12 IF $GET(REPRINT)
IF '$DATA(RXRP(RX,"MG"))
QUIT
+13 NEW FDAMG
SET FDAMG=$$PRINTMG^PSOFDAMG(RX,$PIECE($GET(PSOFDAPT),"^",2))
End DoDot:1
+14 ;
+15 WRITE !
if "C"[$EXTRACT(MW)
WRITE ?21,"CERTIFIED MAIL"
WRITE ?54,"*Signature:____________________________SC NSC*"
+16 WRITE !,?54,"*Print Name:",ULN,"*",!
WRITE $SELECT($GET(PS55)=2:"***DO NOT MAIL***",1:"***CRITICAL MEDICAL SHIPMENT***")
WRITE ?54,"*DEA or VA#_________________Date_____________*",?102,"Routing: "_$SELECT("W"[$EXTRACT(MW):MW,1:MW_" MAIL")
+17 WRITE !,?54,"*Refills: 0 1 2 3 4 5 6 7 8 9 10 11",?99,"*",?102,"Days Supply: ",$GET(DAYS)," Cap: ",$SELECT(PSCAP:"**NON-SFTY**",1:"SAFETY")
+18 WRITE !,?54,"***** To be filled in VA Pharmacies only *****",?102,"Isd: ",ISD," Exp: ",EXPDT,!,PNM,?54,$GET(VAPA(1)),?102,"Last Fill: ",$GET(PSOLASTF)
+19 WRITE !,$SELECT($DATA(PSMP(1)):PSMP(1),1:VAPA(1)),?54,$GET(ADDR(2)),?102,"Pat. Stat ",PATST," Clinic: ",PSCLN
+20 WRITE !,$SELECT($DATA(PSMP(2)):PSMP(2),$DATA(PSMP(1)):"",1:$GET(ADDR(2))),?54,$GET(ADDR(3)),?102,$SELECT($GET(WARN)'="":"DRUG WARNING "_$GET(WARN),1:"")
+21 WRITE !,$SELECT($DATA(PSMP(3)):PSMP(3),$DATA(PSMP(1)):"",1:$GET(ADDR(3))),?54,$GET(ADDR(4))
+22 WRITE !,$SELECT($DATA(PSMP(4)):PSMP(4),$DATA(PSMP(1)):"",1:$GET(ADDR(4))),?54,"*Indicate address change on back of this form",!,?54,"[ ] Permanent [ ] Temporary until ",$SELECT($PIECE($GET(VAPA(10)),"^",2)]"":$PIECE($GET(VAPA(10)),"^",2),1:"__/
__/__")
+23 IF $GET(PSOBARS)
SET X="S"
SET X2=PSOINST_"-"_RX
SET X1=$X
WRITE ?102,@PSOBAR1,X2,@PSOBAR0,$CHAR(13)
SET $X=0
+24 QUIT
NORENW ;NO RENEW
+1 WRITE !,$PIECE(PS,"^",2),?102,"Tech__________RPH__________"
+2 WRITE !,$PIECE(PS,"^",7),", ",STATE," ",$GET(PSOHZIP)
+3 IF $GET(PSOBARS)
IF $PIECE(PSOPAR,"^",19)'=1
SET X="S"
SET X2=PSOINST_"-"_RX
SET X1=$X
WRITE ?54,@PSOBAR1,X2,@PSOBAR0,$CHAR(13)
SET $X=0
+4 IF '$TEST
WRITE !!!!
+5 WRITE "ADDRESS SERVICE REQUESTED",?54,"*** This prescription CANNOT be renewed ***",!
if "C"[$EXTRACT(MW)
WRITE ?21,"CERTIFIED MAIL"
WRITE ?54,"*",?96,"*",!,?54,"* A NEW PRESCRIPTION IS REQUIRED *"
+6 WRITE !,$SELECT($GET(PS55)=2:"***DO NOT MAIL***",1:"***CRITICAL MEDICAL SHIPMENT***"),?54,"*",?96,"*",!,?54,"***** Please contact your physician *******"
+7 WRITE !,?54,$GET(VAPA(1)),?102,"Routing: "_$SELECT("W"[$EXTRACT(MW):MW,1:MW_" MAIL"),!,?54,$GET(ADDR(2)),?102,"Days supply: ",$GET(DAYS)," Cap: ",$SELECT(PSCAP:"**NON-SFTY**",1:"SAFETY")
+8 WRITE !,PNM,?54,$GET(ADDR(3)),?102,"Isd: ",ISD," Exp: ",EXPDT
+9 WRITE !,$SELECT($DATA(PSMP(1)):PSMP(1),1:VAPA(1)),?54,$GET(ADDR(4)),?102,"Last Fill: ",$GET(PSOLASTF)
+10 WRITE !,$SELECT($DATA(PSMP(2)):PSMP(2),$DATA(PSMP(1)):"",1:$GET(ADDR(2))),?54,"*Indicate address change on back of this form",?102,"Pat. Stat ",PATST," Clinic: ",PSCLN
+11 WRITE !,$SELECT($DATA(PSMP(3)):PSMP(3),$DATA(PSMP(1)):"",1:$GET(ADDR(3))),?54,"[ ] Permanent [ ] Temporary until ",$SELECT($PIECE($GET(VAPA(10)),"^",2)]"":$PIECE($GET(VAPA(10)),"^",2),1:"__/__/__"),?102,$SELECT(...
... $GET(WARN)'="":"DRUG WARNING "_$GET(WARN),1:"")
+12 WRITE !,$SELECT($DATA(PSMP(4)):PSMP(4),$DATA(PSMP(1)):"",1:$GET(ADDR(4)))
IF $GET(PSOBARS)
SET X="S"
SET X2=PSOINST_"-"_RX
SET X1=$X
WRITE ?102,@PSOBAR1,X2,@PSOBAR0,$CHAR(13)
SET $X=0
+13 QUIT
ALLWARN ;ALLERGIES WITH DRUG WARNING
+1 IF $GET(PSOBLALL)
IF $PIECE(PPL,",",PI+1)'=""
DO WARN^PSOLBL2
QUIT
+2 KILL ^TMP($JOB,"PSOWARN"),^TMP($JOB,"PSOWPT"),^TMP($JOB,"PSOAPT"),PSONKA,PSONULL
+3 XECUTE "N X S X=""GMRADPT"" X ^%ZOSF(""TEST"") Q"
IF '$TEST
DO WARN^PSOLBL2
QUIT
+4 FOR WWW=1:1
if $PIECE(WARN,",",WWW,99)=""
QUIT
SET PSOWARN=$PIECE(WARN,",",WWW)
if $DATA(^PS(54,PSOWARN,0))
Begin DoDot:1
+5 ;BHW;Modify Loop to use $O instead of 1:1
+6 SET JJJ=0
+7 FOR
SET JJJ=$ORDER(^PS(54,PSOWARN,1,JJJ))
if ('JJJ)
QUIT
Begin DoDot:2
+8 IF $DATA(^PS(54,PSOWARN,1,JJJ,0))
SET ^TMP($JOB,"PSOWARN",PSOWARN,JJJ)=^PS(54,PSOWARN,1,JJJ,0)
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 SET ^TMP($JOB,"PSOWPT",1)=PNM
SET ^(2)="Rx# "_RXN
SET ^(3)=DRUG
SET ^(4)="DRUG WARNING:"
+12 SET WCNT=4
FOR WWW=0:0
SET WWW=$ORDER(^TMP($JOB,"PSOWARN",WWW))
if 'WWW
QUIT
FOR RRR=0:0
SET RRR=$ORDER(^TMP($JOB,"PSOWARN",WWW,RRR))
if 'RRR
QUIT
SET WCNT=WCNT+1
SET ^TMP($JOB,"PSOWPT",WCNT)=^TMP($JOB,"PSOWARN",WWW,RRR)
+13 KILL ^TMP($JOB,"ALWA")
+14 SET GMRA="0^0^111"
DO ^GMRADPT
IF $GET(GMRAL)
FOR PSORY=0:0
SET PSORY=$ORDER(GMRAL(PSORY))
if 'PSORY
QUIT
SET ^TMP($JOB,"ALWA",$SELECT($PIECE(GMRAL(PSORY),"^",4):1,1:2),$SELECT('$PIECE(GMRAL(PSORY),"^",5):1,1:2),$PIECE(GMRAL(PSORY),"^",7),$PIECE(GMRAL(PSORY),"^",2))=""
+15 SET ^TMP($JOB,"PSOAPT",1)=$GET(PNM)_" "_$GET(SSNP)
SET ^(2)=""
SET ^(3)="Verified Allergies"
SET ^(4)="------------------"
+16 SET ALCNT=4
SET EEE=0
SET (PSOLG,PSOLGA)=""
FOR
SET PSOLG=$ORDER(^TMP($JOB,"ALWA",1,1,PSOLG))
if PSOLG=""
QUIT
FOR
SET PSOLGA=$ORDER(^TMP($JOB,"ALWA",1,1,PSOLG,PSOLGA))
if PSOLGA=""
QUIT
SET EEE=1
SET ALCNT=ALCNT+1
SET ^TMP($JOB,"PSOAPT",ALCNT)=" "_PSOLGA
+17 IF EEE
SET ALCNT=ALCNT+1
SET ^TMP($JOB,"PSOAPT",ALCNT)=""
+18 IF 'EEE
Begin DoDot:1
+19 IF $GET(GMRAL)=0
SET ALCNT=ALCNT+1
SET ^TMP($JOB,"PSOAPT",ALCNT)=" "_"NKA"
SET ALCNT=ALCNT+1
SET ^TMP($JOB,"PSOAPT",ALCNT)=""
+20 IF '$TEST
SET ALCNT=ALCNT+1
SET ^TMP($JOB,"PSOAPT",ALCNT)=""
End DoDot:1
+21 SET ALCNT=ALCNT+1
SET ^TMP($JOB,"PSOAPT",ALCNT)="Non-Verified Allergies"
SET ALCNT=ALCNT+1
SET ^TMP($JOB,"PSOAPT",ALCNT)="----------------------"
+22 SET EEE=0
SET (PSOLG,PSOLGA)=""
FOR
SET PSOLG=$ORDER(^TMP($JOB,"ALWA",2,1,PSOLG))
if PSOLG=""
QUIT
FOR
SET PSOLGA=$ORDER(^TMP($JOB,"ALWA",2,1,PSOLG,PSOLGA))
if PSOLGA=""
QUIT
SET EEE=EEE+1
SET ALCNT=ALCNT+1
SET ^TMP($JOB,"PSOAPT",ALCNT)=" "_PSOLGA
+23 IF EEE
SET ALCNT=ALCNT+1
SET ^TMP($JOB,"PSOAPT",ALCNT)=""
+24 IF 'EEE
Begin DoDot:1
+25 IF $GET(GMRAL)=0
SET ALCNT=ALCNT+1
SET ^TMP($JOB,"PSOAPT",ALCNT)=" "_"NKA"
SET ALCNT=ALCNT+1
SET ^TMP($JOB,"PSOAPT",ALCNT)=""
+26 IF '$TEST
SET ALCNT=ALCNT+1
SET ^TMP($JOB,"PSOAPT",ALCNT)=""
End DoDot:1
+27 SET ALCNT=ALCNT+1
SET ^TMP($JOB,"PSOAPT",ALCNT)="Verified Adverse Reactions"
SET ALCNT=ALCNT+1
SET ^TMP($JOB,"PSOAPT",ALCNT)="--------------------------"
+28 SET (PSOLG,PSOLGA)=""
FOR
SET PSOLG=$ORDER(^TMP($JOB,"ALWA",1,2,PSOLG))
if PSOLG=""
QUIT
FOR
SET PSOLGA=$ORDER(^TMP($JOB,"ALWA",1,2,PSOLG,PSOLGA))
if PSOLGA=""
QUIT
SET ALCNT=ALCNT+1
SET ^TMP($JOB,"PSOAPT",ALCNT)=" "_PSOLGA
+29 SET ALCNT=ALCNT+1
SET ^TMP($JOB,"PSOAPT",ALCNT)=""
SET ALCNT=ALCNT+1
SET ^TMP($JOB,"PSOAPT",ALCNT)="Non-Verified Adverse Reactions"
SET ALCNT=ALCNT+1
SET ^TMP($JOB,"PSOAPT",ALCNT)="------------------------------"
+30 SET (PSOLG,PSOLGA)=""
FOR
SET PSOLG=$ORDER(^TMP($JOB,"ALWA",2,2,PSOLG))
if PSOLG=""
QUIT
FOR
SET PSOLGA=$ORDER(^TMP($JOB,"ALWA",2,2,PSOLG,PSOLGA))
if PSOLGA=""
QUIT
SET ALCNT=ALCNT+1
SET ^TMP($JOB,"PSOAPT",ALCNT)=" "_PSOLGA
PRT DO PRINT^PSOLBL2
+1 QUIT
