PSOLBLN ;BIR/RTR - NEW PRINTS LABEL ;11/18/92
;;7.0;OUTPATIENT PHARMACY;**16,36,71,107,110,117,135,233,251,387,379,367,383,318,482,643**;DEC 1997;Build 35
;External reference to ^PSDRUG supported by DBIA 221
;External reference to ^PS(55 supported by DBIA 2228
;External reference to ^VA(200 supported by DBIA 224
;External reference to ^SC( supported by DBIA 254
;Reference to IEN59^BPSOSRX supported by ICR# 4412
;Reference to LOG^BPSOSL supported by ICR# 6764
;
K PSOSTLK,ZTKDRUG I $L($T(PSOSTALK^PSOTALK1)) D PSOSTALK^PSOTALK1 S PSOSTLK=1 ; PRINT SCRIPTALK LABEL IF APPLICABLE
I $G(IOS),$G(PSOBARS) I $G(PSOBAR0)=""!($G(PSOBAR1)="") S PSOIOS=IOS D DEVBAR^PSOBMST
I $G(DFN) D ADD^VADPT
I '$G(COPIES) S COPIES=""
S ADDR(33)=$G(VAPA(4))_", "_$P($G(VAPA(5)),"^",2)_" "_$S($G(VAPA(11))]"":$P($G(VAPA(11)),"^",2),1:$G(VAPA(6))),ADDR(22)=""
S:$G(VAPA(2))]"" ADDR(22)=$G(VAPA(2))_" "_$G(VAPA(3)),ADDR(22)=$E(ADDR(22),1,46) S:ADDR(22)="" ADDR(22)=ADDR(33),ADDR(33)=""
S ADDR(4)=$S(ADDR(33)="":ADDR(22),1:ADDR(33)) I $G(VAPA(2))="",$G(VAPA(3))="" S ADDR(2)=ADDR(4),ADDR(3)="",ADDR(4)="" G ST
I $G(VAPA(2))'="",$G(VAPA(3))="" S ADDR(2)=VAPA(2),ADDR(3)=ADDR(4),ADDR(4)="" G ST
I $G(VAPA(2))="",$G(VAPA(3))'="" S ADDR(2)=VAPA(3),ADDR(3)=ADDR(4),ADDR(4)="" G ST
S ADDR(2)=$G(VAPA(2)),ADDR(3)=$G(VAPA(3))
ST I $P($G(^PSRX(RX,3)),"^",3) S PSOPROV=+$P(^(0),"^",4) S PSOPROV=$S($G(RXP):+$P($G(RXP),"^",17),$G(RXF):+$P($G(^PSRX(RX,1,RXF,0)),"^",17),1:PSOPROV) S:'$G(PSOPROV) PSOPROV=+$P(^PSRX(RX,0),"^",4) D
.I +$P($G(^VA(200,PSOPROV,"PS")),"^",7) S:$P($G(PHYS),"/",2)="" PHYS=$G(PHYS)_"/"_$P($G(^VA(200,+$P($G(^PSRX(RX,3)),"^",3),0)),"^")
;
S:$G(PSOBLALL) PSOBLRX=RX
S:$D(RXRP(RX)) REPRINT=1 S:$D(RXPR(RX)) RXP=RXPR(RX)
I $G(PSOSUREP)!($G(PSOEXREP)) S REPRINT=1 S:'$G(RXRP(RX)) RXRP(RX)=1
S RXY=^PSRX(RX,0),RXSTA=$P(^PSRX(RX,"STA"),"^")
S RXN=$P(RXY,"^"),ISD=$P(RXY,"^",13),RXF=0,DFN=+$P(RXY,"^",2),SIG=$P($G(^PSRX(RX,"SIG")),"^"),ISD=$E(ISD,4,5)_"/"_$E(ISD,6,7)_"/"_($E(ISD,1,3)+1700),ZY=0,$P(LINE,"_",28)="_"
S PSOLBLPS=+$P(RXY,"^",3),PSOLBLDR=+$P(RXY,"^",6)
S NURSE=$S($P($G(^DPT(DFN,"NHC")),"^")="Y":1,$P($G(^PS(55,DFN,40)),"^"):1,1:0) S FDT=$P(^PSRX(RX,2),"^",2),PS=$S($D(^PS(59,PSOSITE,0)):^(0),1:""),PS1=$S($D(^(1)):^(1),1:""),PSOSITE7=$P(^("IB"),"^")
S PS2=$P(PS,"^")_"^"_$P(PS,"^",6)
S (EXPDT,EXDT)=$P(^PSRX(RX,2),"^",6),EXDT=$S('EXDT:"",1:$E(EXDT,4,5)_"/"_$E(EXDT,6,7)_"/"_($E(EXDT,1,3)+1700))
S STATE=$S($D(^DIC(5,+$P(PS,"^",8),0)):$P(^(0),"^",2),1:"UKN")
S DRUG=$$ZZ^PSOSUTL(RX),DEA=$P($G(^PSDRUG(+$P(RXY,"^",6),0)),"^",3),WARN=$P($G(^(0)),"^",8)
I $G(^PSRX(RX,"P",+$G(RXP),0))]"" S RXPI=RXP D
.S RXP=^PSRX(RX,"P",RXP,0)
.S RXY=$P(RXP,"^")_"^"_$P(RXY,"^",2,6)_"^"_$P(RXP,"^",4)_"^"_$P(RXP,"^",10)_"^"_$P(RXY,"^",9)_"^"_$P($G(^PSRX(RX,"SIG")),"^",2)_"^"_$P(RXP,"^",2)_"^"_$P(RXY,"^",12,14)_"^"_$P(^PSRX(RX,"STA"),"^")_"^"_$P(RXP,"^",7)_"^"_$P(RXY,"^",17,99)
.S FDT=$P(RXP,"^")
S MW=$P(RXY,"^",11) I $G(RXFL(RX))'=0 D:$G(RXFL(RX)) I '$G(RXFL(RX)) F I=0:0 S I=$O(^PSRX(RX,1,I)) Q:'I S RXF=RXF+1 S:'$G(RXP) MW=$P(^PSRX(RX,1,I,0),"^",2) I +^PSRX(RX,1,I,0)'<FDT S FDT=+^(0)
.I $G(RXFL(RX)),'$D(^PSRX(RX,1,RXFL(RX),0)) K RXFL(RX) Q
.;PSO*7*266
.S RXF=RXFL(RX) S:'$G(RXP) MW=$P($G(^PSRX(RX,1,RXF,0)),"^",2) F I=0:0 S I=$O(^PSRX(RX,1,I)) Q:'I I +^PSRX(RX,1,I,0)'<FDT S FDT=+^(0)
I MW="W" S PSMP=$G(^PSRX(RX,"MP")) I PSMP]"" D
.N PSJ S PSJ=0 F PSI=1:1:$L(PSMP) S PSMP(PSI)="",PSJ=PSJ+1 F PSJ=PSJ:1 S PSMP(PSI)=PSMP(PSI)_$P(PSMP," ",PSJ)_" " Q:($L(PSMP(PSI))+$L($P(PSMP," ",PSJ+1))>30)
.K PSMP(PSI)
S X=$S($D(^PS(55,DFN,0)):^(0),1:""),PSCAP=$P(X,"^",2),PS55=$P($G(X),"^",3),PS55X=$P($G(X),"^",5)
I (($G(PS55X)]"")&(PS55>1)&(PS55X<DT)) S PS55=0
S:MW="M" MW=$S((PS55=1!(PS55=4)):"R",1:MW)
S MW=$S(MW="M":"REGULAR",MW="R":"CERTIFIED",1:"WINDOW")
I ($G(PSMP(1))']""&($G(PS55)=2)) S PSMP(1)=$G(SSNPN)
S DATE=$E(FDT,1,7),REF=$P(RXY,"^",9)-RXF S:'$G(RXP) $P(^PSRX(RX,3),"^")=FDT S:REF<1 REF=0 D ^PSOLBL2 S II=RX D ^PSORFL,RFLDT^PSORFL
S PATST=$G(^PS(53,+$P(RXY,"^",3),0)) S PRTFL=1 I REF=0 S:('$P(PATST,"^",5))!(DEA["W")!(DEA[1)!(DEA[2) PRTFL=0
S VRPH=$P(^PSRX(RX,2),"^",10),PSCLN=+$P(RXY,"^",5),PSCLN=$S($D(^SC(PSCLN,0)):$P(^(0),"^",2),1:"UNKNOWN")
S PATST=$P(PATST,"^",2),X1=DT,X2=$P(RXY,"^",8)-10 D C^%DTC:REF I $D(^PSRX(RX,2)),$P(^(2),"^",6),REF,X'<$P(^(2),"^",6) S REF=0,VRPH=$P(^(2),"^",10)
;
S COPIES=COPIES-1,$P(ULN,"_",34)="",PSOTRAIL=1 I $G(SIDE) D REP^PSOLBL2 G REP
S (Y,X1)=EXPDT X ^DD("DD") S EXPDT=Y,Y=$P(^PSRX(RX,0),"^",13) X ^DD("DD") S ISD=Y,X2=DT D ^%DTC S DIFF=X
S Y=DATE X ^DD("DD") S DATE=Y D NOW^%DTC S Y=% X ^DD("DD") S NOW=Y
S TECH="("_$S($P($G(^PSRX(+$G(RX),"OR1")),"^",5):$P($G(^PSRX(+$G(RX),"OR1")),"^",5),1:$P(RXY,"^",16))_"/"_$S($G(VRPH)&($P(PSOPAR,"^",32)):VRPH,1:" ")_")"
S PSZIP=$P(PS,"^",5) S PSOHZIP=$S(PSZIP["-":PSZIP,1:$E(PSZIP,1,5)_$S($E(PSZIP,6,9)]"":"-"_$E(PSZIP,6,9),1:""))
L1 W ?3,"VAMC ",$P(PS,"^",7),", ",STATE," ",$G(PSOHZIP),?54,"VAMC ",$P(PS,"^",7),", ",STATE," ",$G(PSOHZIP),?102 W $S($G(REPRINT)&($G(PSOBLALL)):"(GROUP REPRINT)",$G(REPRINT)&('$G(PSOONEVA)):"(REPRINT)",1:"") W:$G(RXP) "(PARTIAL)"
W !?3,$P(PS2,"^",2)," ",$P(PS,"^",3),"-",$P(PS,"^",4)," ",TECH,?54,$P(PS2,"^",2)," ",$P(PS,"^",3),"-",$P(PS,"^",4)," ",TECH,?102,$P(PS2,"^",2)," ",TECH," ",NOW
W !,"Rx# ",RXN," ",DATE," Fill ",RXF+1," of ",1+$P(RXY,"^",9),?54,"Rx# ",RXN," ",DATE," Fill ",RXF+1," of ",1+$P(RXY,"^",9),?102,"Rx# ",RXN," ",DATE," Fill ",RXF+1," of ",1+$P(RXY,"^",9)
W !,PNM," ",$G(SSNPN),?54,PNM," ",$G(SSNPN),?102,PNM," ",$G(SSNPN)
F DR=1:1 Q:$G(SGY(DR))="" D:DR=4!(DR=7)!(DR=10)!(DR=13) W !,$G(SGY(DR)),?54,$G(SGY(DR)),?102,$S($G(OSGY(DR))]"":OSGY(DR),1:$G(SGY(DR)))
.F GG=1:1:27 W !
I DR>4 S KK=$S(DR=5!(DR=8)!(DR=11):2,(DR=6)!(DR=9)!(DR=12):1,1:0) I KK F HH=1:1:KK W !
I DR=2 W !!
I DR=3 W !
W !,$G(PHYS),?54,$G(PHYS),?102,$G(PHYS)
S PSMF=$S($G(NURSE):"Mfg______Exp______",1:""),PSDU=$P($G(^PSDRUG($P($G(^PSRX(RX,0)),"^",6),660)),"^",8),PSDU=$S(PSDU="":" "_PSMF,1:PSDU_" "_PSMF)
W !,"Qty: "_$G(QTY)," ",$G(PSDU),?54,"Qty: "_$G(QTY)," ",$G(PSDU),?102,"Qty: "_$G(QTY)," ",$G(PSDU)
S ZTKDRUG="XXXXXX SCRIPTALK RX XXXXXX"
I '$G(PSOSTLK) K PSDU,PSMF W !,DRUG,?54,DRUG,?102,DRUG
I $G(PSOSTLK) K PSDU,PSMF W !,$S($G(PSOSTALK):ZTKDRUG,1:DRUG),?54,DRUG,?102,DRUG
I $P(RXY,"^",9)-RXF'>0 D ^PSOLBLN1 G L13
G:DIFF<30 L11
W !?54,$P(RXY,"^",9)-RXF," Refills remain prior to ",EXPDT,?102,"Mfg "_$G(MFG)_" Lot# "_$G(LOT) G L12
L11 W !?54,"Last fill prior to ",$G(EXPDT),?102,"Mfg "_$G(MFG)_" Lot# "_$G(LOT)
L12 W !,$P(PS,"^",2),?54,$S($L($G(COPAYVAR)):$G(COPAYVAR)_" ",1:""),"Days Supply: ",$G(DAYS),?102,"Tech__________RPh_________",!,$P(PS,"^",7),", ",STATE," ",$G(PSOHZIP)
;send a CR for OPTIFIL (P-MT661BC)
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 W:IOST["P-MT661BC" !
E W !!!
W !,"ADDRESS SERVICE REQUESTED"
;
; 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:"C"[$E(MW) !,?21,"CERTIFIED MAIL" W !?54,$G(VAPA(1))
W !,$S($G(PS55)=2:"***DO NOT MAIL***",1:"***CRITICAL MEDICAL SHIPMENT***"),?54,$G(ADDR(2)),?102,"Routing: "_$S("W"[$E(MW):MW,1:MW_" MAIL")
W !?54,$G(ADDR(3)),?102,"Days supply: ",$G(DAYS)," Cap: ",$S(PSCAP:"**NON-SFTY**",1:"SAFETY")
W !?54,$G(ADDR(4)),?102,"Isd: ",ISD," Exp: ",EXPDT
W !,PNM,?54,"*Indicate address change on back of this form",?102,"Last Fill: ",$G(PSOLASTF)
W !,$S($D(PSMP(1)):PSMP(1),1:$G(VAPA(1))),?54,"[ ] Permanent",?102,"Pat. Stat ",PATST," Clinic: ",PSCLN
W !,$S($D(PSMP(2)):PSMP(2),$D(PSMP(1)):"",1:$G(ADDR(2))),?54,"[ ] 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(3)):PSMP(3),$D(PSMP(1)):"",1:$G(ADDR(3))),!,$S($D(PSMP(4)):PSMP(4),$D(PSMP(1)):"",1:$G(ADDR(4))),?54,"Signature",ULN
I $G(PSOBARS) S X="S",X2=PSOINST_"-"_RX S X1=$X W ?102,@PSOBAR1,X2,@PSOBAR0,$C(13) S $X=0
L13 I $G(WARN)'="",'$G(PSOBLALL) I '$G(PSDFNFLG),'$G(PSOLAPPL) D WARN^PSOLBL2
W @IOF
REP I COPIES>0 S SIDE=1 G ST
D NOW^%DTC S NOW=% K %,%H,%I I $G(RXF)="" S RXF=0 F I=0:0 S I=$O(^PSRX(RX,1,I)) Q:'I S RXF=I
S IR=0 F FDA=0:0 S FDA=$O(^PSRX(RX,"L",FDA)) Q:'FDA S IR=FDA
S IR=IR+1,^PSRX(RX,"L",0)="^52.032DA^"_IR_"^"_IR
S ^PSRX(RX,"L",IR,0)=NOW_"^"_$S($G(RXP):99-RXPI,1:RXF)_"^"_$S($G(PCOMX)]"":$G(PCOMX),$G(PCOMH(RX))]"":PCOMH(RX),1:"From RX number "_$P(^PSRX(RX,0),"^"))_$S($G(RXP):" (Partial)",1:"")_$S($G(REPRINT)&('$G(PSOONEVA)):" (Reprint)",1:"")_"^"_PDUZ
;
; Add info about the label being printed to the Developer's Log.
D LOGLBL(RX,RXF,$G(RESP))
;
N PSOBADR,PSOTEMP
S PSOBADR=$$CHKRX^PSOBAI(RX)
I $G(PSOBADR) S PSOTEMP=$P(PSOBADR,"^",2),PSOBADR=$P(PSOBADR,"^")
I $G(PSOBADR),'$G(PSOTEMP) D
.S IR=IR+1,^PSRX(RX,"L",0)="^52.032DA^"_IR_"^"_IR
.S ^PSRX(RX,"L",IR,0)=NOW_"^"_$S($G(RXP):99-RXPI,1:RXF)_"^"_"ROUTING="_$G(MW)_" (BAD ADDRESS)"_"^"_PDUZ
;Storing FDA Medication Guide filename in the Prescription file
I $$MGONFILE^PSOFDAUT(RX) D
. I $G(RXRP(RX)),'$G(RXRP(RX,"MG")) Q
. S ^PSRX(RX,"L",IR,"FDA")=$P($$MGONFILE^PSOFDAUT(RX),"^",2)
S ^PSRX(RX,"TYPE")=0 K RXF,IR,FDA,NOW,I,PCOMH(RX)
I $G(WARN)'="" I $G(PSDFNFLG)!($G(PSOLAPPL)) D ALLWARN^PSOLBLN1
I $G(WARN)="" I $G(PSDFNFLG)!($G(PSOLAPPL)) D ALL^PSOLBLS
I $G(PSOBLALL) D:$G(WARN)="" ALL^PSOLBLS D:$G(WARN)'="" ALLWARN^PSOLBLN1
I '$D(PSSPND),$P(PSOPAR,"^",18) I $G(PSDFNFLG)!($G(PSOLAPPL))!($G(PSOBLALL)) D CHCK2^PSOTRLBL
D:$G(PSOBLALL) TRAIL^PSOLBL2
END ;
I $D(RXFLX(RX)) S RXFL(RX)=$G(RXFLX(RX)) K RXFLX
D KILL^PSOLBL2 Q
;
LOGLBL(PSORX,PSORXF,PSORESP) ;
;Input Parameters:
; PSORX - IEN to the Prescription file
; PSORXF - Refill number of the Rx
; PSORESP - ECME Response Info, if defined the 4th piece will contain the ECME Status
;
; Log ECME Claim Status, Menu Option and Action, and whether or not there are
; any Open Rejects, to the Developer's Log. If there are Open Rejects, log the
; Code and date/time. This will help in troubleshooting when future label
; issues are identified.
;
N PSOCD,PSODT,PSOFND,PSOIEN59,PSOLOG,PSOORD,PSOREJDATA,PSORIEN,PSOSTAT
;
; If PSOIEN59 is not found Quit, it is required in order make an entry in
; Developers Log.
S PSOIEN59=$$IEN59^BPSOSRX(PSORX,PSORXF)
I PSOIEN59="" Q
;
S PSOSTAT=$P($G(PSORESP),U,4)
I PSOSTAT="" S PSOSTAT=$$STATUS^PSOBPSUT(PSORX,PSORXF)
D LOG^BPSOSL(PSOIEN59,$T(+0)_"-ECME Claim Status: "_PSOSTAT) ; ICR #4412,6764
;
I $D(XQY0) D LOG^BPSOSL(PSOIEN59,$T(+0)_"-Menu Option: "_$P(XQY0,U)_"-"_$P(XQY0,U,2))
;
; The kernel variable XQORNOD(0) captures the Action, however this variable is not
; always available to for us to use. We know that XQORNOD(0) is not available when
; a user selects either ED or PP from the Medication Profile.
; To determine if PP was selected, go to the EMCE User Screen and select VER-View
; Prescription. Check the ECME Log comments for ECME:PULLED FROM SUSPENSE.
; If the Prescription has been edited(ED) this will be annotated when you go to the
; Medication Profile and select SO. The Remarks will contain "New Order Created by
; editing Rx # nnnnn."
I $D(XQORNOD(0)) D
. S PSOORD=$P(XQORNOD(0),U,2)
. S PSOLOG=$$GET1^DIQ(101,PSOORD,.01)_"-"_$$GET1^DIQ(101,PSOORD,1)
. I $$GET1^DIQ(101,PSOORD,44) S PSOLOG=PSOLOG_"-"_$$GET1^DIQ(101,PSOORD,44)
. D LOG^BPSOSL(PSOIEN59,$T(+0)_"-Action: "_PSOLOG)
E D
. D LOG^BPSOSL(PSOIEN59,$T(+0)_"-Action: Unavailable")
;
; Check for any Open Rejects on Third Party Payer Reject Worklist.
S PSOFND=$$FIND^PSOREJUT(PSORX,PSORXF,.PSOREJDATA)
;
; Log a message if no Open Rejects were found.
I 'PSOFND D LOG^BPSOSL(PSOIEN59,$T(+0)_"-Open Rejects: None on WL")
E D
. ;
. ; If Open Rejects are found, log the Code and Date/Time for each reject.
. S PSORIEN=""
. F S PSORIEN=$O(PSOREJDATA(PSORIEN)) Q:'PSORIEN D
. . S PSOCD=PSOREJDATA(PSORIEN,"CODE"),PSODT=PSOREJDATA(PSORIEN,"DATE/TIME")
. . D LOG^BPSOSL(PSOIEN59,$T(+0)_"-Open rejects: "_PSOCD_", "_PSODT)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOLBLN 12302 printed Apr 09, 2024@21:28:57 Page 2
PSOLBLN ;BIR/RTR - NEW PRINTS LABEL ;11/18/92
+1 ;;7.0;OUTPATIENT PHARMACY;**16,36,71,107,110,117,135,233,251,387,379,367,383,318,482,643**;DEC 1997;Build 35
+2 ;External reference to ^PSDRUG supported by DBIA 221
+3 ;External reference to ^PS(55 supported by DBIA 2228
+4 ;External reference to ^VA(200 supported by DBIA 224
+5 ;External reference to ^SC( supported by DBIA 254
+6 ;Reference to IEN59^BPSOSRX supported by ICR# 4412
+7 ;Reference to LOG^BPSOSL supported by ICR# 6764
+8 ;
+9 ; PRINT SCRIPTALK LABEL IF APPLICABLE
KILL PSOSTLK,ZTKDRUG
IF $LENGTH($TEXT(PSOSTALK^PSOTALK1))
DO PSOSTALK^PSOTALK1
SET PSOSTLK=1
+10 IF $GET(IOS)
IF $GET(PSOBARS)
IF $GET(PSOBAR0)=""!($GET(PSOBAR1)="")
SET PSOIOS=IOS
DO DEVBAR^PSOBMST
+11 IF $GET(DFN)
DO ADD^VADPT
+12 IF '$GET(COPIES)
SET COPIES=""
+13 SET ADDR(33)=$GET(VAPA(4))_", "_$PIECE($GET(VAPA(5)),"^",2)_" "_$SELECT($GET(VAPA(11))]"":$PIECE($GET(VAPA(11)),"^",2),1:$GET(VAPA(6)))
SET ADDR(22)=""
+14 if $GET(VAPA(2))]""
SET ADDR(22)=$GET(VAPA(2))_" "_$GET(VAPA(3))
SET ADDR(22)=$EXTRACT(ADDR(22),1,46)
if ADDR(22)=""
SET ADDR(22)=ADDR(33)
SET ADDR(33)=""
+15 SET ADDR(4)=$SELECT(ADDR(33)="":ADDR(22),1:ADDR(33))
IF $GET(VAPA(2))=""
IF $GET(VAPA(3))=""
SET ADDR(2)=ADDR(4)
SET ADDR(3)=""
SET ADDR(4)=""
GOTO ST
+16 IF $GET(VAPA(2))'=""
IF $GET(VAPA(3))=""
SET ADDR(2)=VAPA(2)
SET ADDR(3)=ADDR(4)
SET ADDR(4)=""
GOTO ST
+17 IF $GET(VAPA(2))=""
IF $GET(VAPA(3))'=""
SET ADDR(2)=VAPA(3)
SET ADDR(3)=ADDR(4)
SET ADDR(4)=""
GOTO ST
+18 SET ADDR(2)=$GET(VAPA(2))
SET ADDR(3)=$GET(VAPA(3))
ST IF $PIECE($GET(^PSRX(RX,3)),"^",3)
SET PSOPROV=+$PIECE(^(0),"^",4)
SET PSOPROV=$SELECT($GET(RXP):+$PIECE($GET(RXP),"^",17),$GET(RXF):+$PIECE($GET(^PSRX(RX,1,RXF,0)),"^",17),1:PSOPROV)
if '$GET(PSOPROV)
SET PSOPROV=+$PIECE(^PSRX(RX,0),"^",4)
Begin DoDot:1
+1 IF +$PIECE($GET(^VA(200,PSOPROV,"PS")),"^",7)
if $PIECE($GET(PHYS),"/",2)=""
SET PHYS=$GET(PHYS)_"/"_$PIECE($GET(^VA(200,+$PIECE($GET(^PSRX(RX,3)),"^",3),0)),"^")
End DoDot:1
+2 ;
+3 if $GET(PSOBLALL)
SET PSOBLRX=RX
+4 if $DATA(RXRP(RX))
SET REPRINT=1
if $DATA(RXPR(RX))
SET RXP=RXPR(RX)
+5 IF $GET(PSOSUREP)!($GET(PSOEXREP))
SET REPRINT=1
if '$GET(RXRP(RX))
SET RXRP(RX)=1
+6 SET RXY=^PSRX(RX,0)
SET RXSTA=$PIECE(^PSRX(RX,"STA"),"^")
+7 SET RXN=$PIECE(RXY,"^")
SET ISD=$PIECE(RXY,"^",13)
SET RXF=0
SET DFN=+$PIECE(RXY,"^",2)
SET SIG=$PIECE($GET(^PSRX(RX,"SIG")),"^")
SET ISD=$EXTRACT(ISD,4,5)_"/"_$EXTRACT(ISD,6,7)_"/"_($EXTRACT(ISD,1,3)+1700)
SET ZY=0
SET $PIECE(LINE,"_",28)="_"
+8 SET PSOLBLPS=+$PIECE(RXY,"^",3)
SET PSOLBLDR=+$PIECE(RXY,"^",6)
+9 SET NURSE=$SELECT($PIECE($GET(^DPT(DFN,"NHC")),"^")="Y":1,$PIECE($GET(^PS(55,DFN,40)),"^"):1,1:0)
SET FDT=$PIECE(^PSRX(RX,2),"^",2)
SET PS=$SELECT($DATA(^PS(59,PSOSITE,0)):^(0),1:"")
SET PS1=$SELECT($DATA(^(1)):^(1),1:"")
SET PSOSITE7=$PIECE(^("IB"),"^")
+10 SET PS2=$PIECE(PS,"^")_"^"_$PIECE(PS,"^",6)
+11 SET (EXPDT,EXDT)=$PIECE(^PSRX(RX,2),"^",6)
SET EXDT=$SELECT('EXDT:"",1:$EXTRACT(EXDT,4,5)_"/"_$EXTRACT(EXDT,6,7)_"/"_($EXTRACT(EXDT,1,3)+1700))
+12 SET STATE=$SELECT($DATA(^DIC(5,+$PIECE(PS,"^",8),0)):$PIECE(^(0),"^",2),1:"UKN")
+13 SET DRUG=$$ZZ^PSOSUTL(RX)
SET DEA=$PIECE($GET(^PSDRUG(+$PIECE(RXY,"^",6),0)),"^",3)
SET WARN=$PIECE($GET(^(0)),"^",8)
+14 IF $GET(^PSRX(RX,"P",+$GET(RXP),0))]""
SET RXPI=RXP
Begin DoDot:1
+15 SET RXP=^PSRX(RX,"P",RXP,0)
+16 SET RXY=$PIECE(RXP,"^")_"^"_$PIECE(RXY,"^",2,6)_"^"_$PIECE(RXP,"^",4)_"^"_$PIECE(RXP,"^",10)_"^"_...
... $PIECE(RXY,"^",9)_"^"_$PIECE($GET(^PSRX(RX,"SIG")),"^",2)_"^"_$PIECE(RXP,"^",2)_"^"_$PIECE(RXY,"^",12,14)_"^"_$PIECE(^PSRX(RX,"STA"),"^")_"^"_$PIECE(RXP,"^",7)_"^"_$PIECE(RXY,"^",17,99)
+17 SET FDT=$PIECE(RXP,"^")
End DoDot:1
+18 SET MW=$PIECE(RXY,"^",11)
IF $GET(RXFL(RX))'=0
if $GET(RXFL(RX))
Begin DoDot:1
+19 IF $GET(RXFL(RX))
IF '$DATA(^PSRX(RX,1,RXFL(RX),0))
KILL RXFL(RX)
QUIT
+20 ;PSO*7*266
+21 SET RXF=RXFL(RX)
if '$GET(RXP)
SET MW=$PIECE($GET(^PSRX(RX,1,RXF,0)),"^",2)
FOR I=0:0
SET I=$ORDER(^PSRX(RX,1,I))
if 'I
QUIT
IF +^PSRX(RX,1,I,0)'<FDT
SET FDT=+^(0)
End DoDot:1
IF '$GET(RXFL(RX))
FOR I=0:0
SET I=$ORDER(^PSRX(RX,1,I))
if 'I
QUIT
SET RXF=RXF+1
if '$GET(RXP)
SET MW=$PIECE(^PSRX(RX,1,I,0),"^",2)
IF +^PSRX(RX,1,I,0)'<FDT
SET FDT=+^(0)
+22 IF MW="W"
SET PSMP=$GET(^PSRX(RX,"MP"))
IF PSMP]""
Begin DoDot:1
+23 NEW PSJ
SET PSJ=0
FOR PSI=1:1:$LENGTH(PSMP)
SET PSMP(PSI)=""
SET PSJ=PSJ+1
FOR PSJ=PSJ:1
SET PSMP(PSI)=PSMP(PSI)_$PIECE(PSMP," ",PSJ)_" "
if ($LENGTH(PSMP(PSI))+$LENGTH($PIECE(PSMP," ",PSJ+1))>30)
QUIT
+24 KILL PSMP(PSI)
End DoDot:1
+25 SET X=$SELECT($DATA(^PS(55,DFN,0)):^(0),1:"")
SET PSCAP=$PIECE(X,"^",2)
SET PS55=$PIECE($GET(X),"^",3)
SET PS55X=$PIECE($GET(X),"^",5)
+26 IF (($GET(PS55X)]"")&(PS55>1)&(PS55X<DT))
SET PS55=0
+27 if MW="M"
SET MW=$SELECT((PS55=1!(PS55=4)):"R",1:MW)
+28 SET MW=$SELECT(MW="M":"REGULAR",MW="R":"CERTIFIED",1:"WINDOW")
+29 IF ($GET(PSMP(1))']""&($GET(PS55)=2))
SET PSMP(1)=$GET(SSNPN)
+30 SET DATE=$EXTRACT(FDT,1,7)
SET REF=$PIECE(RXY,"^",9)-RXF
if '$GET(RXP)
SET $PIECE(^PSRX(RX,3),"^")=FDT
if REF<1
SET REF=0
DO ^PSOLBL2
SET II=RX
DO ^PSORFL
DO RFLDT^PSORFL
+31 SET PATST=$GET(^PS(53,+$PIECE(RXY,"^",3),0))
SET PRTFL=1
IF REF=0
if ('$PIECE(PATST,"^",5))!(DEA["W")!(DEA[1)!(DEA[2)
SET PRTFL=0
+32 SET VRPH=$PIECE(^PSRX(RX,2),"^",10)
SET PSCLN=+$PIECE(RXY,"^",5)
SET PSCLN=$SELECT($DATA(^SC(PSCLN,0)):$PIECE(^(0),"^",2),1:"UNKNOWN")
+33 SET PATST=$PIECE(PATST,"^",2)
SET X1=DT
SET X2=$PIECE(RXY,"^",8)-10
if REF
DO C^%DTC
IF $DATA(^PSRX(RX,2))
IF $PIECE(^(2),"^",6)
IF REF
IF X'<$PIECE(^(2),"^",6)
SET REF=0
SET VRPH=$PIECE(^(2),"^",10)
+34 ;
+35 SET COPIES=COPIES-1
SET $PIECE(ULN,"_",34)=""
SET PSOTRAIL=1
IF $GET(SIDE)
DO REP^PSOLBL2
GOTO REP
+36 SET (Y,X1)=EXPDT
XECUTE ^DD("DD")
SET EXPDT=Y
SET Y=$PIECE(^PSRX(RX,0),"^",13)
XECUTE ^DD("DD")
SET ISD=Y
SET X2=DT
DO ^%DTC
SET DIFF=X
+37 SET Y=DATE
XECUTE ^DD("DD")
SET DATE=Y
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET NOW=Y
+38 SET TECH="("_$SELECT($PIECE($GET(^PSRX(+$GET(RX),"OR1")),"^",5):$PIECE($GET(^PSRX(+$GET(RX),"OR1")),"^",5),1:$PIECE(RXY,"^",16))_"/"_$SELECT($GET(VRPH)&($PIECE(PSOPAR,"^",32)):VRPH,1:" ")_")"
+39 SET PSZIP=$PIECE(PS,"^",5)
SET PSOHZIP=$SELECT(PSZIP["-":PSZIP,1:$EXTRACT(PSZIP,1,5)_$SELECT($EXTRACT(PSZIP,6,9)]"":"-"_$EXTRACT(PSZIP,6,9),1:""))
L1 WRITE ?3,"VAMC ",$PIECE(PS,"^",7),", ",STATE," ",$GET(PSOHZIP),?54,"VAMC ",$PIECE(PS,"^",7),", ",STATE," ",$GET(PSOHZIP),?102
WRITE $SELECT($GET(REPRINT)&($GET(PSOBLALL)):"(GROUP REPRINT)",$GET(REPRINT)&('$GET(PSOONEVA)):"(REPRINT)",1:"")
if $GET(RXP)
WRITE "(PARTIAL)"
+1 WRITE !?3,$PIECE(PS2,"^",2)," ",$PIECE(PS,"^",3),"-",$PIECE(PS,"^",4)," ",TECH,?54,$PIECE(PS2,"^",2)," ",$PIECE(PS,"^",3),"-",$PIECE(PS,"^",4)," ",TECH,?102,$PIECE(PS2,"^",2)," ",TECH," ",NOW
+2 WRITE !,"Rx# ",RXN," ",DATE," Fill ",RXF+1," of ",1+$PIECE(RXY,"^",9),?54,"Rx# ",RXN," ",DATE," Fill ",RXF+1," of ",1+$PIECE(RXY,"^",9),?102,"Rx# ",RXN," ",DATE," Fill ",RXF+1," of ",1+$PIECE(RXY,"^",9)
+3 WRITE !,PNM," ",$GET(SSNPN),?54,PNM," ",$GET(SSNPN),?102,PNM," ",$GET(SSNPN)
+4 FOR DR=1:1
if $GET(SGY(DR))=""
QUIT
if DR=4!(DR=7)!(DR=10)!(DR=13)
Begin DoDot:1
+5 FOR GG=1:1:27
WRITE !
End DoDot:1
WRITE !,$GET(SGY(DR)),?54,$GET(SGY(DR)),?102,$SELECT($GET(OSGY(DR))]"":OSGY(DR),1:$GET(SGY(DR)))
+6 IF DR>4
SET KK=$SELECT(DR=5!(DR=8)!(DR=11):2,(DR=6)!(DR=9)!(DR=12):1,1:0)
IF KK
FOR HH=1:1:KK
WRITE !
+7 IF DR=2
WRITE !!
+8 IF DR=3
WRITE !
+9 WRITE !,$GET(PHYS),?54,$GET(PHYS),?102,$GET(PHYS)
+10 SET PSMF=$SELECT($GET(NURSE):"Mfg______Exp______",1:"")
SET PSDU=$PIECE($GET(^PSDRUG($PIECE($GET(^PSRX(RX,0)),"^",6),660)),"^",8)
SET PSDU=$SELECT(PSDU="":" "_PSMF,1:PSDU_" "_PSMF)
+11 WRITE !,"Qty: "_$GET(QTY)," ",$GET(PSDU),?54,"Qty: "_$GET(QTY)," ",$GET(PSDU),?102,"Qty: "_$GET(QTY)," ",$GET(PSDU)
+12 SET ZTKDRUG="XXXXXX SCRIPTALK RX XXXXXX"
+13 IF '$GET(PSOSTLK)
KILL PSDU,PSMF
WRITE !,DRUG,?54,DRUG,?102,DRUG
+14 IF $GET(PSOSTLK)
KILL PSDU,PSMF
WRITE !,$SELECT($GET(PSOSTALK):ZTKDRUG,1:DRUG),?54,DRUG,?102,DRUG
+15 IF $PIECE(RXY,"^",9)-RXF'>0
DO ^PSOLBLN1
GOTO L13
+16 if DIFF<30
GOTO L11
+17 WRITE !?54,$PIECE(RXY,"^",9)-RXF," Refills remain prior to ",EXPDT,?102,"Mfg "_$GET(MFG)_" Lot# "_$GET(LOT)
GOTO L12
L11 WRITE !?54,"Last fill prior to ",$GET(EXPDT),?102,"Mfg "_$GET(MFG)_" Lot# "_$GET(LOT)
L12 WRITE !,$PIECE(PS,"^",2),?54,$SELECT($LENGTH($GET(COPAYVAR)):$GET(COPAYVAR)_" ",1:""),"Days Supply: ",$GET(DAYS),?102,"Tech__________RPh_________",!,$PIECE(PS,"^",7),", ",STATE," ",$GET(PSOHZIP)
+1 ;send a CR for OPTIFIL (P-MT661BC)
+2 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
if IOST["P-MT661BC"
WRITE !
+3 IF '$TEST
WRITE !!!
+4 WRITE !,"ADDRESS SERVICE REQUESTED"
+5 ;
+6 ; Printing FDA Medication Guide (if there's one)
+7 IF $$MGONFILE^PSOFDAUT(RX)
Begin DoDot:1
+8 WRITE ?102,"Read FDA Med Guide"
+9 IF $GET(REPRINT)
IF '$DATA(RXRP(RX,"MG"))
QUIT
+10 NEW FDAMG
SET FDAMG=$$PRINTMG^PSOFDAMG(RX,$PIECE($GET(PSOFDAPT),"^",2))
End DoDot:1
+11 ;
+12 if "C"[$EXTRACT(MW)
WRITE !,?21,"CERTIFIED MAIL"
WRITE !?54,$GET(VAPA(1))
+13 WRITE !,$SELECT($GET(PS55)=2:"***DO NOT MAIL***",1:"***CRITICAL MEDICAL SHIPMENT***"),?54,$GET(ADDR(2)),?102,"Routing: "_$SELECT("W"[$EXTRACT(MW):MW,1:MW_" MAIL")
+14 WRITE !?54,$GET(ADDR(3)),?102,"Days supply: ",$GET(DAYS)," Cap: ",$SELECT(PSCAP:"**NON-SFTY**",1:"SAFETY")
+15 WRITE !?54,$GET(ADDR(4)),?102,"Isd: ",ISD," Exp: ",EXPDT
+16 WRITE !,PNM,?54,"*Indicate address change on back of this form",?102,"Last Fill: ",$GET(PSOLASTF)
+17 WRITE !,$SELECT($DATA(PSMP(1)):PSMP(1),1:$GET(VAPA(1))),?54,"[ ] Permanent",?102,"Pat. Stat ",PATST," Clinic: ",PSCLN
+18 WRITE !,$SELECT($DATA(PSMP(2)):PSMP(2),$DATA(PSMP(1)):"",1:$GET(ADDR(2))),?54,"[ ] Temporary until ",$SELECT($PIECE($GET(VAPA(10)),"^",2)]"":$PIECE($GET(VAPA(10)),"^",2),1:"__/__/__"),?102,$SELECT($GET(WARN)'="":"DRUG WARNING "_$GET(WARN),1:"")
+19 WRITE !,$SELECT($DATA(PSMP(3)):PSMP(3),$DATA(PSMP(1)):"",1:$GET(ADDR(3))),!,$SELECT($DATA(PSMP(4)):PSMP(4),$DATA(PSMP(1)):"",1:$GET(ADDR(4))),?54,"Signature",ULN
+20 IF $GET(PSOBARS)
SET X="S"
SET X2=PSOINST_"-"_RX
SET X1=$X
WRITE ?102,@PSOBAR1,X2,@PSOBAR0,$CHAR(13)
SET $X=0
L13 IF $GET(WARN)'=""
IF '$GET(PSOBLALL)
IF '$GET(PSDFNFLG)
IF '$GET(PSOLAPPL)
DO WARN^PSOLBL2
+1 WRITE @IOF
REP IF COPIES>0
SET SIDE=1
GOTO ST
+1 DO NOW^%DTC
SET NOW=%
KILL %,%H,%I
IF $GET(RXF)=""
SET RXF=0
FOR I=0:0
SET I=$ORDER(^PSRX(RX,1,I))
if 'I
QUIT
SET RXF=I
+2 SET IR=0
FOR FDA=0:0
SET FDA=$ORDER(^PSRX(RX,"L",FDA))
if 'FDA
QUIT
SET IR=FDA
+3 SET IR=IR+1
SET ^PSRX(RX,"L",0)="^52.032DA^"_IR_"^"_IR
+4 SET ^PSRX(RX,"L",IR,0)=NOW_"^"_$SELECT($GET(RXP):99-RXPI,1:RXF)_"^"_...
... $SELECT($GET(PCOMX)]"":$GET(PCOMX),$GET(PCOMH(RX))]"":PCOMH(RX),1:"From RX number "_$PIECE(^PSRX(RX,0),"^"))_$SELECT($GET(RXP):" (Partial)",1:"")_$SELECT($GET(REPRINT)&('$GET(PSOONEVA)):" (Reprint)",1:"")_"^"_PDUZ
+5 ;
+6 ; Add info about the label being printed to the Developer's Log.
+7 DO LOGLBL(RX,RXF,$GET(RESP))
+8 ;
+9 NEW PSOBADR,PSOTEMP
+10 SET PSOBADR=$$CHKRX^PSOBAI(RX)
+11 IF $GET(PSOBADR)
SET PSOTEMP=$PIECE(PSOBADR,"^",2)
SET PSOBADR=$PIECE(PSOBADR,"^")
+12 IF $GET(PSOBADR)
IF '$GET(PSOTEMP)
Begin DoDot:1
+13 SET IR=IR+1
SET ^PSRX(RX,"L",0)="^52.032DA^"_IR_"^"_IR
+14 SET ^PSRX(RX,"L",IR,0)=NOW_"^"_$SELECT($GET(RXP):99-RXPI,1:RXF)_"^"_"ROUTING="_$GET(MW)_" (BAD ADDRESS)"_"^"_PDUZ
End DoDot:1
+15 ;Storing FDA Medication Guide filename in the Prescription file
+16 IF $$MGONFILE^PSOFDAUT(RX)
Begin DoDot:1
+17 IF $GET(RXRP(RX))
IF '$GET(RXRP(RX,"MG"))
QUIT
+18 SET ^PSRX(RX,"L",IR,"FDA")=$PIECE($$MGONFILE^PSOFDAUT(RX),"^",2)
End DoDot:1
+19 SET ^PSRX(RX,"TYPE")=0
KILL RXF,IR,FDA,NOW,I,PCOMH(RX)
+20 IF $GET(WARN)'=""
IF $GET(PSDFNFLG)!($GET(PSOLAPPL))
DO ALLWARN^PSOLBLN1
+21 IF $GET(WARN)=""
IF $GET(PSDFNFLG)!($GET(PSOLAPPL))
DO ALL^PSOLBLS
+22 IF $GET(PSOBLALL)
if $GET(WARN)=""
DO ALL^PSOLBLS
if $GET(WARN)'=""
DO ALLWARN^PSOLBLN1
+23 IF '$DATA(PSSPND)
IF $PIECE(PSOPAR,"^",18)
IF $GET(PSDFNFLG)!($GET(PSOLAPPL))!($GET(PSOBLALL))
DO CHCK2^PSOTRLBL
+24 if $GET(PSOBLALL)
DO TRAIL^PSOLBL2
END ;
+1 IF $DATA(RXFLX(RX))
SET RXFL(RX)=$GET(RXFLX(RX))
KILL RXFLX
+2 DO KILL^PSOLBL2
QUIT
+3 ;
LOGLBL(PSORX,PSORXF,PSORESP) ;
+1 ;Input Parameters:
+2 ; PSORX - IEN to the Prescription file
+3 ; PSORXF - Refill number of the Rx
+4 ; PSORESP - ECME Response Info, if defined the 4th piece will contain the ECME Status
+5 ;
+6 ; Log ECME Claim Status, Menu Option and Action, and whether or not there are
+7 ; any Open Rejects, to the Developer's Log. If there are Open Rejects, log the
+8 ; Code and date/time. This will help in troubleshooting when future label
+9 ; issues are identified.
+10 ;
+11 NEW PSOCD,PSODT,PSOFND,PSOIEN59,PSOLOG,PSOORD,PSOREJDATA,PSORIEN,PSOSTAT
+12 ;
+13 ; If PSOIEN59 is not found Quit, it is required in order make an entry in
+14 ; Developers Log.
+15 SET PSOIEN59=$$IEN59^BPSOSRX(PSORX,PSORXF)
+16 IF PSOIEN59=""
QUIT
+17 ;
+18 SET PSOSTAT=$PIECE($GET(PSORESP),U,4)
+19 IF PSOSTAT=""
SET PSOSTAT=$$STATUS^PSOBPSUT(PSORX,PSORXF)
+20 ; ICR #4412,6764
DO LOG^BPSOSL(PSOIEN59,$TEXT(+0)_"-ECME Claim Status: "_PSOSTAT)
+21 ;
+22 IF $DATA(XQY0)
DO LOG^BPSOSL(PSOIEN59,$TEXT(+0)_"-Menu Option: "_$PIECE(XQY0,U)_"-"_$PIECE(XQY0,U,2))
+23 ;
+24 ; The kernel variable XQORNOD(0) captures the Action, however this variable is not
+25 ; always available to for us to use. We know that XQORNOD(0) is not available when
+26 ; a user selects either ED or PP from the Medication Profile.
+27 ; To determine if PP was selected, go to the EMCE User Screen and select VER-View
+28 ; Prescription. Check the ECME Log comments for ECME:PULLED FROM SUSPENSE.
+29 ; If the Prescription has been edited(ED) this will be annotated when you go to the
+30 ; Medication Profile and select SO. The Remarks will contain "New Order Created by
+31 ; editing Rx # nnnnn."
+32 IF $DATA(XQORNOD(0))
Begin DoDot:1
+33 SET PSOORD=$PIECE(XQORNOD(0),U,2)
+34 SET PSOLOG=$$GET1^DIQ(101,PSOORD,.01)_"-"_$$GET1^DIQ(101,PSOORD,1)
+35 IF $$GET1^DIQ(101,PSOORD,44)
SET PSOLOG=PSOLOG_"-"_$$GET1^DIQ(101,PSOORD,44)
+36 DO LOG^BPSOSL(PSOIEN59,$TEXT(+0)_"-Action: "_PSOLOG)
End DoDot:1
+37 IF '$TEST
Begin DoDot:1
+38 DO LOG^BPSOSL(PSOIEN59,$TEXT(+0)_"-Action: Unavailable")
End DoDot:1
+39 ;
+40 ; Check for any Open Rejects on Third Party Payer Reject Worklist.
+41 SET PSOFND=$$FIND^PSOREJUT(PSORX,PSORXF,.PSOREJDATA)
+42 ;
+43 ; Log a message if no Open Rejects were found.
+44 IF 'PSOFND
DO LOG^BPSOSL(PSOIEN59,$TEXT(+0)_"-Open Rejects: None on WL")
+45 IF '$TEST
Begin DoDot:1
+46 ;
+47 ; If Open Rejects are found, log the Code and Date/Time for each reject.
+48 SET PSORIEN=""
+49 FOR
SET PSORIEN=$ORDER(PSOREJDATA(PSORIEN))
if 'PSORIEN
QUIT
Begin DoDot:2
+50 SET PSOCD=PSOREJDATA(PSORIEN,"CODE")
SET PSODT=PSOREJDATA(PSORIEN,"DATE/TIME")
+51 DO LOG^BPSOSL(PSOIEN59,$TEXT(+0)_"-Open rejects: "_PSOCD_", "_PSODT)
End DoDot:2
End DoDot:1
+52 ;
+53 QUIT
