PSOERUT4 ;ALB/MFR - eRx Drug Suggestion Utilities; 06/25/2023 5:14pm
;;7.0;OUTPATIENT PHARMACY;**700,746,769,770**;DEC 1997;Build 145
;
CSPRV(PROV,DRG,ORN) ; Sets CS Information (DEA#, Detox #, Site Address,...)
N DETN,DEA,I,LBL,VADD,SPC
I PROV="" Q
S:$L($G(PSORX("RXDEA"))) DEA=PSORX("RXDEA")
I '$L($G(DEA)) D
. S DEA=$S($G(PENDATA("OIRXN")):$$RXDEA^PSOUTIL(PENDATA("OIRXN")),$G(ORN):$$RXDEA^PSOUTIL(,ORN),1:$$DEA^XUSER(0,PROV))
. S:DEA]"" PSORX("RXDEA")=DEA
S:$L($G(PSORX("DETX"))) DETN=PSORX("DETX")
S LBL="DEA#: "
I DRG,$$DETOX^PSSOPKI(DRG),'$L($G(DETN)) D
. S DETN=$S($G(ORN):$$RXDETOX^PSOUTIL(,ORN),1:$$DETOX^XUSER(PROV))
S $P(SPC," ",(33-$L(DEA)))=" "
I (DEA'="")!($G(DETN)'="") D
. S XV="|"_LBL_$$COMPARE^PSOERUT0("LM",DEA,DEA,41+$L(LBL))
. S XV=XV_$S($G(DETN)]"":SPC_"DETOX#: "_$$COMPARE^PSOERUT0("LM",$G(DETN),$G(DETN),49+$L(SPC)),1:"")
. D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
I $G(ORN) D PRVAD^PSOPKIV2 I $G(VADD(1))]"" D
. S XV="|Site Address: "_$$COMPARE^PSOERUT0("LM",VADD(1),VADD(1),15)
. D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
. I VADD(2)'="" S XV="| "_$$COMPARE^PSOERUT0("LM",VADD(2),VADD(2),15)
. D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
. I VADD(3)'="" S XV="| "_$$COMPARE^PSOERUT0("LM",VADD(3),VADD(3),15)
. D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
Q
;
VASIG(ORD) ; Returns The Pending Order SIG
; Input: ORD - Pointer to the PENDING ORDER file (#52.41)
;Output: VASIG - VistA SIG in one long string
N VASIG,SIG
S VASIG="",ORD=+$G(ORD)
S SIG=0 F S SIG=$O(^PS(52.41,ORD,"SIG",SIG)) Q:'SIG D
. I $E(VASIG,$L(VASIG))'=" " S VASIG=VASIG_" "
. S VASIG=VASIG_$G(^PS(52.41,ORD,"SIG",SIG,0))
Q VASIG
;
ERXDOSE(ERXIEN,DOSEARR,INTVAL) ; Retrieves the Dosage for an eRx and loads an Array
; Input: ERXIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
; (o)INTVAL - 1: Use Internal Value Flag | 0/null: External Value
;Output:.DOSEARR - Return Array Containing Dosage Information
;
N ERXDOSE,DOSE
K DOSEARR D GETS^DIQ(52.49,ERXIEN,"21*","IE","ERXDOSE")
S DOSE="" F S DOSE=$O(ERXDOSE(52.4921,DOSE)) Q:DOSE="" D
. S DOSEARR("DOSE ORDERED",+DOSE)=ERXDOSE(52.4921,DOSE,9,"I")
. S DOSEARR("DOSE",+DOSE)=ERXDOSE(52.4921,DOSE,8,"I")
. S DOSEARR("UNITS",+DOSE)=ERXDOSE(52.4921,DOSE,11,"I")
. S DOSEARR("NOUN",+DOSE)=ERXDOSE(52.4921,DOSE,12,"I")
. S DOSEARR("DURATION",+DOSE)=ERXDOSE(52.4921,DOSE,2,"I")
. I $G(ERXDOSE(52.4921,DOSE,6,$S($G(INTVAL):"I",1:"E")))'="" D
. . S DOSEARR("CONJUNCTION",+DOSE)=ERXDOSE(52.4921,DOSE,6,$S($G(INTVAL):"I",1:"E"))
. S DOSEARR("ROUTE",+DOSE)=ERXDOSE(52.4921,DOSE,10,$S($G(INTVAL):"I",1:"E"))
. S DOSEARR("SCHEDULE",+DOSE)=ERXDOSE(52.4921,DOSE,1,"I")
. S DOSEARR("VERB",+DOSE)=ERXDOSE(52.4921,DOSE,13,"I")
Q
;
VARXDOSE(RXIEN,DOSEARR) ; Retrieves the Dosage for a PRESCRIPTION and loads an Array
; Input: RXIEN - Pointer to the PRESCRIPTION file (#52)
;Output: .DOSEARR - Return Array Containing Dosage Information
;
; - Retrieving VistA Rx Dose and Saving to the eRx
N VADOSE,DOSE
I '$D(^PSRX(+$G(RXIEN),0)) Q
K DOSEARR D GETS^DIQ(52,RXIEN,"113*","I","VADOSE")
S DOSE="" F S DOSE=$O(VADOSE(52.0113,DOSE)) Q:DOSE="" D
. S DOSEARR("DOSE ORDERED",+DOSE)=VADOSE(52.0113,DOSE,1,"I")
. S DOSEARR("DOSE",+DOSE)=VADOSE(52.0113,DOSE,.01,"I")
. S DOSEARR("UNITS",+DOSE)=VADOSE(52.0113,DOSE,2,"I")
. S DOSEARR("NOUN",+DOSE)=VADOSE(52.0113,DOSE,3,"I")
. S DOSEARR("DURATION",+DOSE)=VADOSE(52.0113,DOSE,4,"I")
. I VADOSE(52.0113,DOSE,5,"I")'="" D
. . S DOSEARR("CONJUNCTION",+DOSE)=VADOSE(52.0113,DOSE,5,"I")
. S DOSEARR("ROUTE",+DOSE)=VADOSE(52.0113,DOSE,6,"I")
. S DOSEARR("SCHEDULE",+DOSE)=VADOSE(52.0113,DOSE,7,"I")
. S DOSEARR("VERB",+DOSE)=VADOSE(52.0113,DOSE,8,"I")
Q
;
PODOSAGE(NMSPC,ORDIEN,PENDATA,RENEWORD) ; Set ListMan Side-By-Side Section for VistA Pending Order Dosage
;Input: NMSPC - ListMan Temp Global Namespace (e.g., "PSOERXP1", "PSOPO", ...)
; ORDIEN - Pointer to PENDING OUTPATIENT ORDERS file (#52.41)
; PENDATA - Array containing the Pending Order data
; RENEWORD - Renewal Pending Order? 1: YES | 0/null - NO ; Sets Pending Order Dosage Information
N DOSE,XE,XEI,XV,XVI,LMLINE,DFN,I,WRPDOSE,DISPUNTS,ROUTE,CONJUNCT,PDUE,DUESEQ,COAGENT,REASON,RESULT,ACK
N ALLLN,ERXALLS,DOSEX,ERXLINES,VAALLS,VALINES,VAOTHINS
S DFN=+$$GET1^DIQ(52.41,ORDIEN,1,"I")
;
D PDUEDATA^PSOERXU9(.PDUE,ERXIEN,1)
S XEI=0,LMLINE=LINE-1
S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)="Prescriber Drug Use Evaluation:"
I '$D(PDUE) D
. S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)=" None",HIGHLN(LMLINE,2)=4
E D
. F DUESEQ=1:1 Q:'$D(PDUE(DUESEQ)) D
. . S COAGENT=$P(PDUE(DUESEQ),"^",8)
. . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)="Co-Agent: "_$$COMPARE^PSOERUT0("LM",$E(COAGENT,1,29),$E(COAGENT,1,29),11,,LMLINE)
. . I $L(COAGENT)>29 D
. . . F I=1:1 S COAGENT=$E(COAGENT,30,999) Q:COAGENT="" D
. . . . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)=" "_$$COMPARE^PSOERUT0("LM",$E(COAGENT,1,29),$E(COAGENT,1,29),11,,LMLINE)
. . S REASON=$P(PDUE(DUESEQ),"^",2) I $$PRESOLV^PSOERXA1(REASON,"REA") S REASON=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(REASON,"REA"),.02)
. . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)="Reason: "_$$COMPARE^PSOERUT0("LM",$E(REASON,1,30),$E(REASON,1,30),9,,LMLINE)
. . I $L(REASON)>31 D
. . . F I=1:1 S REASON=$E(REASON,32,999) Q:REASON="" D
. . . . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)=" "_$$COMPARE^PSOERUT0("LM",$E(REASON,1,31),$E(REASON,1,31),9,,LMLINE)
. . S RESULT=$P(PDUE(DUESEQ),"^",4) I $$PRESOLV^PSOERXA1(RESULT,"RES") S RESULT=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(RESULT,"RES"),.02)
. . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)="Result: "_$$COMPARE^PSOERUT0("LM",$E(RESULT,1,31),$E(RESULT,1,31),9,,LMLINE)
. . I $L(RESULT)>31 D
. . . F I=1:1 S RESULT=$E(RESULT,32,999) Q:RESULT="" D
. . . . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)=" "_$$COMPARE^PSOERUT0("LM",$E(RESULT,1,31),$E(RESULT,1,31),8,,LMLINE)
. . S ACK=$P(PDUE(DUESEQ),"^",9)
. . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)="Override: "_$$COMPARE^PSOERUT0("LM",$E(ACK,1,29),$E(ACK,1,29),11,,LMLINE)
. . I $L(ACK)>29 D
. . . F I=1:1 S ACK=$E(ACK,30,999) Q:ACK="" D
. . . . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)=" "_$$COMPARE^PSOERUT0("LM",$E(ACK,1,29),$E(ACK,1,29),11,,LMLINE)
. . I $O(PDUE(DUESEQ)) S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)="......................................"
;
S XVI=0,LMLINE=LINE-1
I '$D(PENDATA) D Q
. S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=$S('RENEWORD:"3) ",1:" ")_" *Dosage:"
F DOSE=1:1 Q:'$D(PENDATA("DOSE",DOSE)) D
. I '$G(PENDATA("DOSE ORDERED",DOSE)),$G(PENDATA("VERB",DOSE))]"" D
. . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" Verb: "_$$COMPARE^PSOERUT0("LM",PENDATA("VERB",DOSE),PENDATA("VERB",DOSE),55,,LMLINE)
. S DOSEX=PENDATA("DOSE",DOSE) I $E(DOSEX,1)=".",$G(PENDATA("DOSE ORDERED",DOSE)) S DOSEX="0"_DOSEX
. I $G(PENDATA("UNITS",DOSE))]"" S DOSEX=DOSEX_" ("_$$GET1^DIQ(50.607,PENDATA("UNITS",DOSE),.01)_")"
. D WRAP^PSOERUT(DOSEX,24,.WRPDOSE)
. S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=$S(DOSE=1&'RENEWORD:"3)",1:" ")_" *Dosage: "_$$COMPARE^PSOERUT0("LM",$G(WRPDOSE(1,0)),$G(WRPDOSE(1,0)),55,,LMLINE)
. I DOSE=1,'RENEWORD S UNDERLN(LMLINE,41)=2
. F I=2:1 Q:'$D(WRPDOSE(I)) D
. . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$G(WRPDOSE(I,0)),$G(WRPDOSE(I,0)),55,,LMLINE)
. I $G(PENDATA("DOSE ORDERED",DOSE)),$G(PENDATA("VERB",DOSE))]"" D
. . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" Verb: "_$$COMPARE^PSOERUT0("LM",PENDATA("VERB",DOSE),PENDATA("VERB",DOSE),55,,LMLINE)
. I '$G(PENDATA("DOSE ORDERED",DOSE)),$P($G(^PS(55,DFN,"LAN")),"^") D
. . D WRAP^PSOERUT($G(PENDATA("ODOSE",DOSE)),22,.WRPDOSE)
. . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)="*Oth.Lang.Dosage: "_$$COMPARE^PSOERUT0("LM",$G(WRPDOSE(1,0)),$G(WRPDOSE(1,0)),59,,LMLINE)
. . F I=2:1 Q:'$D(WRPDOSE(I)) D
. . . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$G(WRPDOSE(I,0)),$G(WRPDOSE(I,0)),59,,LMLINE)
. I $G(PENDATA("DOSE ORDERED",DOSE))'="" D
. . S DISPUNTS=$S($E(PENDATA("DOSE ORDERED",DOSE),1)=".":"0",1:"")_PENDATA("DOSE ORDERED",DOSE)
. . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" Disp. Units: "_$$COMPARE^PSOERUT0("LM",DISPUNTS,DISPUNTS,55,,LMLINE)
. I $G(PENDATA("NOUN",DOSE))'="" D
. . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" Noun: "_$$COMPARE^PSOERUT0("LM",PENDATA("NOUN",DOSE),PENDATA("NOUN",DOSE),55,,LMLINE)
. I $G(PENDATA("ROUTE",DOSE)) S ROUTE=$$GET1^DIQ(51.2,PENDATA("ROUTE",DOSE),.01)
. S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" *Route: "_$$COMPARE^PSOERUT0("LM",$G(ROUTE),$G(ROUTE),55,,LMLINE)
. S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" *Schedule: "_$$COMPARE^PSOERUT0("LM",PENDATA("SCHEDULE",DOSE),PENDATA("SCHEDULE",DOSE),55,,LMLINE)
. I $G(PENDATA("DURATION",DOSE))'="" D
. . N DUR S DUR=PENDATA("DURATION",DOSE)
. . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" *Duration: "_$$COMPARE^PSOERUT0("LM",DUR_" "_$$FREQ(DUR),DUR_" "_$$FREQ(DUR),55,,LMLINE)
. I $G(PENDATA("CONJUNCTION",DOSE))'="" D
. . S CONJUNCT=$S(PENDATA("CONJUNCTION",DOSE)="T":"THEN",PENDATA("CONJUNCTION",DOSE)="X":"EXCEPT",1:"AND")
. . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)="*Conjunction: "_$$COMPARE^PSOERUT0("LM",CONJUNCT,CONJUNCT,55,,LMLINE)
;
; - Patient Instructions
S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)="________________________________________"
S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=$S('RENEWORD:"4) ",1:"")_"Patient Instruction:"
I 'RENEWORD S UNDERLN(LMLINE,41)=2
S VAPATINS="" F I=1:1 Q:'$D(PENDATA("SIG",I)) S VAPATINS=VAPATINS_" "_$$UP^XLFSTR($G(PENDATA("SIG",I)))
S $E(VAPATINS)=""
I VAPATINS'="" D
. K VARR D WRAP^PSOERUT(VAPATINS,39,.VARR)
. F I=1:1 Q:'$D(VARR(I)) D
. . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$G(VARR(I,0)),$G(VARR(I,0)),42,,LMLINE)
I $O(PENDATA("SINS",0)) D
. S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" Other Lang. Pat. Instruct:"
. S VAOTHINS="" F I=1:1 Q:'$D(PENDATA("SINS",I)) S VAOTHINS=VAOTHINS_" "_$$UP^XLFSTR($G(PENDATA("SINS",I)))
. S $E(VAOTHINS)=""
. K VARR D WRAP^PSOERUT(VAOTHINS,39,.VARR)
. F I=1:1 Q:'$D(VARR(I)) D
. . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$G(VARR(I,0)),$G(VARR(I,0)),42,,LMLINE)
; - Patient Indications
I $G(PENDATA("IND"))'="" D
. I '$D(PENDATA("INDF")) S PENDATA("INDF")=+$$GET1^DIQ(52.49,ERXIEN,29.1,"I")
. S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)="Indications:"
. S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$E(PENDATA("IND"),1,38),$E(PENDATA("IND"),1,38),42,,LMLINE)
. I $L(PENDATA("IND"))>38 D
. . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$E(PENDATA("IND"),39,99),$E(PENDATA("IND"),39,99),42,,LMLINE)
I $G(PENDATA("INDO"))'="",+$G(DFN),$P($G(^PS(55,+$G(DFN),"LAN")),"^"),$G(PENDATA("INDO"))'="" D
. S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)="Other Indications:"
. S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$E(PENDATA("INDO"),1,38),$E(PENDATA("INDO"),1,38),42,,LMLINE)
. I $L(PENDATA("INDO"))>38 D
. . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$E(PENDATA("INDO"),39,99),$E(PENDATA("INDO"),39,99),42,,LMLINE)
;
; - Setting eRx Prescriber Drug Use Evaluation (DUE), Matched Dosage, Patient Instructions, and Indications For Use
F ALLLN=1:1 Q:('$D(ERXLINES(ALLLN))&'$D(VALINES(ALLLN))) D
. S ERXALLS=$G(ERXLINES(ALLLN)),VAALLS=$G(VALINES(ALLLN))
. S XE=$G(ERXLINES(ALLLN))
. S XV="|"_$G(VALINES(ALLLN))
. D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
;
Q
;
PENFLAG(NMSPC,ORD) ; Backdoor ListManager Display of Flag/Unflag Information
N FLAG,FLAGHDR,XX,FLAGCOMM
;
D GETS^DIQ(52.41,ORD,"33;34;35;36;37;38","IE","FLAG") I '$G(FLAG(52.41,ORD_",",33,"I")) Q
S XX="Order Flagged by "_FLAG(52.41,ORD_",",34,"E")_" on "_FLAG(52.41,ORD_",",33,"E")
S FLAGHDR="",$E(FLAGHDR,(81-$L(XX))/2)=XX
S UNDERLN(LINE,1)=100
D ADDLINE^PSOERUT0("LM",NMSPC,FLAGHDR,"")
S XX=FLAG(52.41,ORD_",",35,"E")
F Q:XX="" D
. S FLAGCOMM=" "_$$COMPARE^PSOERUT0("LM",$E(XX,1,79),$E(XX,1,79),2),XX=$E(XX,80,9999)
. D ADDLINE^PSOERUT0("LM",NMSPC,FLAGCOMM,"")
I FLAG(52.41,ORD_",",36,"I")'="" D
. S XX="Order Un-Flagged by "_FLAG(52.41,ORD_",",37,"E")_" on "_FLAG(52.41,ORD_",",36,"E")
. S FLAGHDR="",$E(FLAGHDR,(81-$L(XX))/2)=XX
. S UNDERLN(LINE,1)=100
. D ADDLINE^PSOERUT0("LM",NMSPC,FLAGHDR,"")
. S XX=FLAG(52.41,ORD_",",38,"E")
. F Q:XX="" D
. . S FLAGCOMM=$E(XX,1,79)
. . S FLAGCOMM=" "_$$COMPARE^PSOERUT0("LM",$E(XX,1,79),$E(XX,1,79),2),XX=$E(XX,80,9999)
. . D ADDLINE^PSOERUT0("LM",NMSPC,FLAGCOMM,"")
D BLANKLN^PSOERUT0("LM",1)
Q
;
ACCDTBY(ERXIEN) ; Returns the eRx latest Accepted Date/Time
; Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
;Output: P1^P2 - P1: External Accepted Date/Time (MM/DD/YY) | P2: Accepted By Name
;
N ACCDTBY,ACDTTM,ACBY,STHIS,FOUND,STAT
S ACCDTBY="",STHIS=99999,FOUND=0
F S STHIS=$O(^PS(52.49,ERXIEN,19,STHIS),-1) Q:'STHIS!(FOUND) D
. I $$GET1^DIQ(52.4919,STHIS_","_ERXIEN,.04,"I") S FOUND=1 Q ; eRx was Un-Accepted
. S STAT=$$GET1^DIQ(52.4919,STHIS_","_ERXIEN,.02,"I")
. I ",PR,RXP,CXP,"[(","_$$GET1^DIQ(52.45,STAT,.01,"E")_",") D
. . S ACCDTBY=$$FMTE^XLFDT($$GET1^DIQ(52.4919,STHIS_","_ERXIEN,.01,"I"),"2Y")_"^"_$$GET1^DIQ(52.4919,STHIS_","_ERXIEN,.03,"E")
. . S FOUND=1
Q ACCDTBY
;
PROVCOMM(COMM) ; Expand Provider Comments
; Input: Provider Comments
;Output: Expanded Comments
N PROVCOMM,X,PSODIR,INS1
I $G(COMM)="" Q ""
S COMM=$$UP^XLFSTR(COMM)
S (X,PSODIR("INS"))=COMM D SIG^PSOHELP S $E(INS1)="",PROVCOMM=INS1
Q PROVCOMM
;
FREQ(DUR) ; Returns the Duration Frequency word (WEEKS, DAYS, etc..)
; Input: DUR - Schedule Duration (e.g., "4D", "3W", "6H", etc...)
;Output: Spelled out duration frequency between parenthesis ("(DAYS)", "(WEEKS)", "(HOURS)", etc...)
S DUR=$G(DUR)
I DUR["M" Q "(MINUTES)"
I DUR["H" Q "(HOURS)"
I DUR["L" Q "(MONTHS)"
I DUR["W" Q "(WEEKS)"
Q "(DAYS)"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERUT4 14229 printed Aug 26, 2025@22:44:10 Page 2
PSOERUT4 ;ALB/MFR - eRx Drug Suggestion Utilities; 06/25/2023 5:14pm
+1 ;;7.0;OUTPATIENT PHARMACY;**700,746,769,770**;DEC 1997;Build 145
+2 ;
CSPRV(PROV,DRG,ORN) ; Sets CS Information (DEA#, Detox #, Site Address,...)
+1 NEW DETN,DEA,I,LBL,VADD,SPC
+2 IF PROV=""
QUIT
+3 if $LENGTH($GET(PSORX("RXDEA")))
SET DEA=PSORX("RXDEA")
+4 IF '$LENGTH($GET(DEA))
Begin DoDot:1
+5 SET DEA=$SELECT($GET(PENDATA("OIRXN")):$$RXDEA^PSOUTIL(PENDATA("OIRXN")),$GET(ORN):$$RXDEA^PSOUTIL(,ORN),1:$$DEA^XUSER(0,PROV))
+6 if DEA]""
SET PSORX("RXDEA")=DEA
End DoDot:1
+7 if $LENGTH($GET(PSORX("DETX")))
SET DETN=PSORX("DETX")
+8 SET LBL="DEA#: "
+9 IF DRG
IF $$DETOX^PSSOPKI(DRG)
IF '$LENGTH($GET(DETN))
Begin DoDot:1
+10 SET DETN=$SELECT($GET(ORN):$$RXDETOX^PSOUTIL(,ORN),1:$$DETOX^XUSER(PROV))
End DoDot:1
+11 SET $PIECE(SPC," ",(33-$LENGTH(DEA)))=" "
+12 IF (DEA'="")!($GET(DETN)'="")
Begin DoDot:1
+13 SET XV="|"_LBL_$$COMPARE^PSOERUT0("LM",DEA,DEA,41+$LENGTH(LBL))
+14 SET XV=XV_$SELECT($GET(DETN)]"":SPC_"DETOX#: "_$$COMPARE^PSOERUT0("LM",$GET(DETN),$GET(DETN),49+$LENGTH(SPC)),1:"")
+15 DO ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
End DoDot:1
+16 IF $GET(ORN)
DO PRVAD^PSOPKIV2
IF $GET(VADD(1))]""
Begin DoDot:1
+17 SET XV="|Site Address: "_$$COMPARE^PSOERUT0("LM",VADD(1),VADD(1),15)
+18 DO ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
+19 IF VADD(2)'=""
SET XV="| "_$$COMPARE^PSOERUT0("LM",VADD(2),VADD(2),15)
+20 DO ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
+21 IF VADD(3)'=""
SET XV="| "_$$COMPARE^PSOERUT0("LM",VADD(3),VADD(3),15)
+22 DO ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
End DoDot:1
+23 QUIT
+24 ;
VASIG(ORD) ; Returns The Pending Order SIG
+1 ; Input: ORD - Pointer to the PENDING ORDER file (#52.41)
+2 ;Output: VASIG - VistA SIG in one long string
+3 NEW VASIG,SIG
+4 SET VASIG=""
SET ORD=+$GET(ORD)
+5 SET SIG=0
FOR
SET SIG=$ORDER(^PS(52.41,ORD,"SIG",SIG))
if 'SIG
QUIT
Begin DoDot:1
+6 IF $EXTRACT(VASIG,$LENGTH(VASIG))'=" "
SET VASIG=VASIG_" "
+7 SET VASIG=VASIG_$GET(^PS(52.41,ORD,"SIG",SIG,0))
End DoDot:1
+8 QUIT VASIG
+9 ;
ERXDOSE(ERXIEN,DOSEARR,INTVAL) ; Retrieves the Dosage for an eRx and loads an Array
+1 ; Input: ERXIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
+2 ; (o)INTVAL - 1: Use Internal Value Flag | 0/null: External Value
+3 ;Output:.DOSEARR - Return Array Containing Dosage Information
+4 ;
+5 NEW ERXDOSE,DOSE
+6 KILL DOSEARR
DO GETS^DIQ(52.49,ERXIEN,"21*","IE","ERXDOSE")
+7 SET DOSE=""
FOR
SET DOSE=$ORDER(ERXDOSE(52.4921,DOSE))
if DOSE=""
QUIT
Begin DoDot:1
+8 SET DOSEARR("DOSE ORDERED",+DOSE)=ERXDOSE(52.4921,DOSE,9,"I")
+9 SET DOSEARR("DOSE",+DOSE)=ERXDOSE(52.4921,DOSE,8,"I")
+10 SET DOSEARR("UNITS",+DOSE)=ERXDOSE(52.4921,DOSE,11,"I")
+11 SET DOSEARR("NOUN",+DOSE)=ERXDOSE(52.4921,DOSE,12,"I")
+12 SET DOSEARR("DURATION",+DOSE)=ERXDOSE(52.4921,DOSE,2,"I")
+13 IF $GET(ERXDOSE(52.4921,DOSE,6,$SELECT($GET(INTVAL):"I",1:"E")))'=""
Begin DoDot:2
+14 SET DOSEARR("CONJUNCTION",+DOSE)=ERXDOSE(52.4921,DOSE,6,$SELECT($GET(INTVAL):"I",1:"E"))
End DoDot:2
+15 SET DOSEARR("ROUTE",+DOSE)=ERXDOSE(52.4921,DOSE,10,$SELECT($GET(INTVAL):"I",1:"E"))
+16 SET DOSEARR("SCHEDULE",+DOSE)=ERXDOSE(52.4921,DOSE,1,"I")
+17 SET DOSEARR("VERB",+DOSE)=ERXDOSE(52.4921,DOSE,13,"I")
End DoDot:1
+18 QUIT
+19 ;
VARXDOSE(RXIEN,DOSEARR) ; Retrieves the Dosage for a PRESCRIPTION and loads an Array
+1 ; Input: RXIEN - Pointer to the PRESCRIPTION file (#52)
+2 ;Output: .DOSEARR - Return Array Containing Dosage Information
+3 ;
+4 ; - Retrieving VistA Rx Dose and Saving to the eRx
+5 NEW VADOSE,DOSE
+6 IF '$DATA(^PSRX(+$GET(RXIEN),0))
QUIT
+7 KILL DOSEARR
DO GETS^DIQ(52,RXIEN,"113*","I","VADOSE")
+8 SET DOSE=""
FOR
SET DOSE=$ORDER(VADOSE(52.0113,DOSE))
if DOSE=""
QUIT
Begin DoDot:1
+9 SET DOSEARR("DOSE ORDERED",+DOSE)=VADOSE(52.0113,DOSE,1,"I")
+10 SET DOSEARR("DOSE",+DOSE)=VADOSE(52.0113,DOSE,.01,"I")
+11 SET DOSEARR("UNITS",+DOSE)=VADOSE(52.0113,DOSE,2,"I")
+12 SET DOSEARR("NOUN",+DOSE)=VADOSE(52.0113,DOSE,3,"I")
+13 SET DOSEARR("DURATION",+DOSE)=VADOSE(52.0113,DOSE,4,"I")
+14 IF VADOSE(52.0113,DOSE,5,"I")'=""
Begin DoDot:2
+15 SET DOSEARR("CONJUNCTION",+DOSE)=VADOSE(52.0113,DOSE,5,"I")
End DoDot:2
+16 SET DOSEARR("ROUTE",+DOSE)=VADOSE(52.0113,DOSE,6,"I")
+17 SET DOSEARR("SCHEDULE",+DOSE)=VADOSE(52.0113,DOSE,7,"I")
+18 SET DOSEARR("VERB",+DOSE)=VADOSE(52.0113,DOSE,8,"I")
End DoDot:1
+19 QUIT
+20 ;
PODOSAGE(NMSPC,ORDIEN,PENDATA,RENEWORD) ; Set ListMan Side-By-Side Section for VistA Pending Order Dosage
+1 ;Input: NMSPC - ListMan Temp Global Namespace (e.g., "PSOERXP1", "PSOPO", ...)
+2 ; ORDIEN - Pointer to PENDING OUTPATIENT ORDERS file (#52.41)
+3 ; PENDATA - Array containing the Pending Order data
+4 ; RENEWORD - Renewal Pending Order? 1: YES | 0/null - NO ; Sets Pending Order Dosage Information
+5 NEW DOSE,XE,XEI,XV,XVI,LMLINE,DFN,I,WRPDOSE,DISPUNTS,ROUTE,CONJUNCT,PDUE,DUESEQ,COAGENT,REASON,RESULT,ACK
+6 NEW ALLLN,ERXALLS,DOSEX,ERXLINES,VAALLS,VALINES,VAOTHINS
+7 SET DFN=+$$GET1^DIQ(52.41,ORDIEN,1,"I")
+8 ;
+9 DO PDUEDATA^PSOERXU9(.PDUE,ERXIEN,1)
+10 SET XEI=0
SET LMLINE=LINE-1
+11 SET XEI=XEI+1
SET LMLINE=LMLINE+1
SET ERXLINES(XEI)="Prescriber Drug Use Evaluation:"
+12 IF '$DATA(PDUE)
Begin DoDot:1
+13 SET XEI=XEI+1
SET LMLINE=LMLINE+1
SET ERXLINES(XEI)=" None"
SET HIGHLN(LMLINE,2)=4
End DoDot:1
+14 IF '$TEST
Begin DoDot:1
+15 FOR DUESEQ=1:1
if '$DATA(PDUE(DUESEQ))
QUIT
Begin DoDot:2
+16 SET COAGENT=$PIECE(PDUE(DUESEQ),"^",8)
+17 SET XEI=XEI+1
SET LMLINE=LMLINE+1
SET ERXLINES(XEI)="Co-Agent: "_$$COMPARE^PSOERUT0("LM",$EXTRACT(COAGENT,1,29),$EXTRACT(COAGENT,1,29),11,,LMLINE)
+18 IF $LENGTH(COAGENT)>29
Begin DoDot:3
+19 FOR I=1:1
SET COAGENT=$EXTRACT(COAGENT,30,999)
if COAGENT=""
QUIT
Begin DoDot:4
+20 SET XEI=XEI+1
SET LMLINE=LMLINE+1
SET ERXLINES(XEI)=" "_$$COMPARE^PSOERUT0("LM",$EXTRACT(COAGENT,1,29),$EXTRACT(COAGENT,1,29),11,,LMLINE)
End DoDot:4
End DoDot:3
+21 SET REASON=$PIECE(PDUE(DUESEQ),"^",2)
IF $$PRESOLV^PSOERXA1(REASON,"REA")
SET REASON=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(REASON,"REA"),.02)
+22 SET XEI=XEI+1
SET LMLINE=LMLINE+1
SET ERXLINES(XEI)="Reason: "_$$COMPARE^PSOERUT0("LM",$EXTRACT(REASON,1,30),$EXTRACT(REASON,1,30),9,,LMLINE)
+23 IF $LENGTH(REASON)>31
Begin DoDot:3
+24 FOR I=1:1
SET REASON=$EXTRACT(REASON,32,999)
if REASON=""
QUIT
Begin DoDot:4
+25 SET XEI=XEI+1
SET LMLINE=LMLINE+1
SET ERXLINES(XEI)=" "_$$COMPARE^PSOERUT0("LM",$EXTRACT(REASON,1,31),$EXTRACT(REASON,1,31),9,,LMLINE)
End DoDot:4
End DoDot:3
+26 SET RESULT=$PIECE(PDUE(DUESEQ),"^",4)
IF $$PRESOLV^PSOERXA1(RESULT,"RES")
SET RESULT=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(RESULT,"RES"),.02)
+27 SET XEI=XEI+1
SET LMLINE=LMLINE+1
SET ERXLINES(XEI)="Result: "_$$COMPARE^PSOERUT0("LM",$EXTRACT(RESULT,1,31),$EXTRACT(RESULT,1,31),9,,LMLINE)
+28 IF $LENGTH(RESULT)>31
Begin DoDot:3
+29 FOR I=1:1
SET RESULT=$EXTRACT(RESULT,32,999)
if RESULT=""
QUIT
Begin DoDot:4
+30 SET XEI=XEI+1
SET LMLINE=LMLINE+1
SET ERXLINES(XEI)=" "_$$COMPARE^PSOERUT0("LM",$EXTRACT(RESULT,1,31),$EXTRACT(RESULT,1,31),8,,LMLINE)
End DoDot:4
End DoDot:3
+31 SET ACK=$PIECE(PDUE(DUESEQ),"^",9)
+32 SET XEI=XEI+1
SET LMLINE=LMLINE+1
SET ERXLINES(XEI)="Override: "_$$COMPARE^PSOERUT0("LM",$EXTRACT(ACK,1,29),$EXTRACT(ACK,1,29),11,,LMLINE)
+33 IF $LENGTH(ACK)>29
Begin DoDot:3
+34 FOR I=1:1
SET ACK=$EXTRACT(ACK,30,999)
if ACK=""
QUIT
Begin DoDot:4
+35 SET XEI=XEI+1
SET LMLINE=LMLINE+1
SET ERXLINES(XEI)=" "_$$COMPARE^PSOERUT0("LM",$EXTRACT(ACK,1,29),$EXTRACT(ACK,1,29),11,,LMLINE)
End DoDot:4
End DoDot:3
+36 IF $ORDER(PDUE(DUESEQ))
SET XEI=XEI+1
SET LMLINE=LMLINE+1
SET ERXLINES(XEI)="......................................"
End DoDot:2
End DoDot:1
+37 ;
+38 SET XVI=0
SET LMLINE=LINE-1
+39 IF '$DATA(PENDATA)
Begin DoDot:1
+40 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)=$SELECT('RENEWORD:"3) ",1:" ")_" *Dosage:"
End DoDot:1
QUIT
+41 FOR DOSE=1:1
if '$DATA(PENDATA("DOSE",DOSE))
QUIT
Begin DoDot:1
+42 IF '$GET(PENDATA("DOSE ORDERED",DOSE))
IF $GET(PENDATA("VERB",DOSE))]""
Begin DoDot:2
+43 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)=" Verb: "_$$COMPARE^PSOERUT0("LM",PENDATA("VERB",DOSE),PENDATA("VERB",DOSE),55,,LMLINE)
End DoDot:2
+44 SET DOSEX=PENDATA("DOSE",DOSE)
IF $EXTRACT(DOSEX,1)="."
IF $GET(PENDATA("DOSE ORDERED",DOSE))
SET DOSEX="0"_DOSEX
+45 IF $GET(PENDATA("UNITS",DOSE))]""
SET DOSEX=DOSEX_" ("_$$GET1^DIQ(50.607,PENDATA("UNITS",DOSE),.01)_")"
+46 DO WRAP^PSOERUT(DOSEX,24,.WRPDOSE)
+47 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)=$SELECT(DOSE=1&'RENEWORD:"3)",1:" ")_" *Dosage: "_$$COMPARE^PSOERUT0("LM",$GET(WRPDOSE(1,0)),$GET(WRPDOSE(1,0)),55,,LMLINE)
+48 IF DOSE=1
IF 'RENEWORD
SET UNDERLN(LMLINE,41)=2
+49 FOR I=2:1
if '$DATA(WRPDOSE(I))
QUIT
Begin DoDot:2
+50 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$GET(WRPDOSE(I,0)),$GET(WRPDOSE(I,0)),55,,LMLINE)
End DoDot:2
+51 IF $GET(PENDATA("DOSE ORDERED",DOSE))
IF $GET(PENDATA("VERB",DOSE))]""
Begin DoDot:2
+52 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)=" Verb: "_$$COMPARE^PSOERUT0("LM",PENDATA("VERB",DOSE),PENDATA("VERB",DOSE),55,,LMLINE)
End DoDot:2
+53 IF '$GET(PENDATA("DOSE ORDERED",DOSE))
IF $PIECE($GET(^PS(55,DFN,"LAN")),"^")
Begin DoDot:2
+54 DO WRAP^PSOERUT($GET(PENDATA("ODOSE",DOSE)),22,.WRPDOSE)
+55 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)="*Oth.Lang.Dosage: "_$$COMPARE^PSOERUT0("LM",$GET(WRPDOSE(1,0)),$GET(WRPDOSE(1,0)),59,,LMLINE)
+56 FOR I=2:1
if '$DATA(WRPDOSE(I))
QUIT
Begin DoDot:3
+57 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$GET(WRPDOSE(I,0)),$GET(WRPDOSE(I,0)),59,,LMLINE)
End DoDot:3
End DoDot:2
+58 IF $GET(PENDATA("DOSE ORDERED",DOSE))'=""
Begin DoDot:2
+59 SET DISPUNTS=$SELECT($EXTRACT(PENDATA("DOSE ORDERED",DOSE),1)=".":"0",1:"")_PENDATA("DOSE ORDERED",DOSE)
+60 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)=" Disp. Units: "_$$COMPARE^PSOERUT0("LM",DISPUNTS,DISPUNTS,55,,LMLINE)
End DoDot:2
+61 IF $GET(PENDATA("NOUN",DOSE))'=""
Begin DoDot:2
+62 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)=" Noun: "_$$COMPARE^PSOERUT0("LM",PENDATA("NOUN",DOSE),PENDATA("NOUN",DOSE),55,,LMLINE)
End DoDot:2
+63 IF $GET(PENDATA("ROUTE",DOSE))
SET ROUTE=$$GET1^DIQ(51.2,PENDATA("ROUTE",DOSE),.01)
+64 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)=" *Route: "_$$COMPARE^PSOERUT0("LM",$GET(ROUTE),$GET(ROUTE),55,,LMLINE)
+65 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)=" *Schedule: "_$$COMPARE^PSOERUT0("LM",PENDATA("SCHEDULE",DOSE),PENDATA("SCHEDULE",DOSE),55,,LMLINE)
+66 IF $GET(PENDATA("DURATION",DOSE))'=""
Begin DoDot:2
+67 NEW DUR
SET DUR=PENDATA("DURATION",DOSE)
+68 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)=" *Duration: "_$$COMPARE^PSOERUT0("LM",DUR_" "_$$FREQ(DUR),DUR_" "_$$FREQ(DUR),55,,LMLINE)
End DoDot:2
+69 IF $GET(PENDATA("CONJUNCTION",DOSE))'=""
Begin DoDot:2
+70 SET CONJUNCT=$SELECT(PENDATA("CONJUNCTION",DOSE)="T":"THEN",PENDATA("CONJUNCTION",DOSE)="X":"EXCEPT",1:"AND")
+71 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)="*Conjunction: "_$$COMPARE^PSOERUT0("LM",CONJUNCT,CONJUNCT,55,,LMLINE)
End DoDot:2
End DoDot:1
+72 ;
+73 ; - Patient Instructions
+74 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)="________________________________________"
+75 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)=$SELECT('RENEWORD:"4) ",1:"")_"Patient Instruction:"
+76 IF 'RENEWORD
SET UNDERLN(LMLINE,41)=2
+77 SET VAPATINS=""
FOR I=1:1
if '$DATA(PENDATA("SIG",I))
QUIT
SET VAPATINS=VAPATINS_" "_$$UP^XLFSTR($GET(PENDATA("SIG",I)))
+78 SET $EXTRACT(VAPATINS)=""
+79 IF VAPATINS'=""
Begin DoDot:1
+80 KILL VARR
DO WRAP^PSOERUT(VAPATINS,39,.VARR)
+81 FOR I=1:1
if '$DATA(VARR(I))
QUIT
Begin DoDot:2
+82 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$GET(VARR(I,0)),$GET(VARR(I,0)),42,,LMLINE)
End DoDot:2
End DoDot:1
+83 IF $ORDER(PENDATA("SINS",0))
Begin DoDot:1
+84 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)=" Other Lang. Pat. Instruct:"
+85 SET VAOTHINS=""
FOR I=1:1
if '$DATA(PENDATA("SINS",I))
QUIT
SET VAOTHINS=VAOTHINS_" "_$$UP^XLFSTR($GET(PENDATA("SINS",I)))
+86 SET $EXTRACT(VAOTHINS)=""
+87 KILL VARR
DO WRAP^PSOERUT(VAOTHINS,39,.VARR)
+88 FOR I=1:1
if '$DATA(VARR(I))
QUIT
Begin DoDot:2
+89 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$GET(VARR(I,0)),$GET(VARR(I,0)),42,,LMLINE)
End DoDot:2
End DoDot:1
+90 ; - Patient Indications
+91 IF $GET(PENDATA("IND"))'=""
Begin DoDot:1
+92 IF '$DATA(PENDATA("INDF"))
SET PENDATA("INDF")=+$$GET1^DIQ(52.49,ERXIEN,29.1,"I")
+93 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)="Indications:"
+94 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$EXTRACT(PENDATA("IND"),1,38),$EXTRACT(PENDATA("IND"),1,38),42,,LMLINE)
+95 IF $LENGTH(PENDATA("IND"))>38
Begin DoDot:2
+96 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$EXTRACT(PENDATA("IND"),39,99),$EXTRACT(PENDATA("IND"),39,99),42,,LMLINE)
End DoDot:2
End DoDot:1
+97 IF $GET(PENDATA("INDO"))'=""
IF +$GET(DFN)
IF $PIECE($GET(^PS(55,+$GET(DFN),"LAN")),"^")
IF $GET(PENDATA("INDO"))'=""
Begin DoDot:1
+98 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)="Other Indications:"
+99 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$EXTRACT(PENDATA("INDO"),1,38),$EXTRACT(PENDATA("INDO"),1,38),42,,LMLINE)
+100 IF $LENGTH(PENDATA("INDO"))>38
Begin DoDot:2
+101 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$EXTRACT(PENDATA("INDO"),39,99),$EXTRACT(PENDATA("INDO"),39,99),42,,LMLINE)
End DoDot:2
End DoDot:1
+102 ;
+103 ; - Setting eRx Prescriber Drug Use Evaluation (DUE), Matched Dosage, Patient Instructions, and Indications For Use
+104 FOR ALLLN=1:1
if ('$DATA(ERXLINES(ALLLN))&'$DATA(VALINES(ALLLN)))
QUIT
Begin DoDot:1
+105 SET ERXALLS=$GET(ERXLINES(ALLLN))
SET VAALLS=$GET(VALINES(ALLLN))
+106 SET XE=$GET(ERXLINES(ALLLN))
+107 SET XV="|"_$GET(VALINES(ALLLN))
+108 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
End DoDot:1
+109 ;
+110 QUIT
+111 ;
PENFLAG(NMSPC,ORD) ; Backdoor ListManager Display of Flag/Unflag Information
+1 NEW FLAG,FLAGHDR,XX,FLAGCOMM
+2 ;
+3 DO GETS^DIQ(52.41,ORD,"33;34;35;36;37;38","IE","FLAG")
IF '$GET(FLAG(52.41,ORD_",",33,"I"))
QUIT
+4 SET XX="Order Flagged by "_FLAG(52.41,ORD_",",34,"E")_" on "_FLAG(52.41,ORD_",",33,"E")
+5 SET FLAGHDR=""
SET $EXTRACT(FLAGHDR,(81-$LENGTH(XX))/2)=XX
+6 SET UNDERLN(LINE,1)=100
+7 DO ADDLINE^PSOERUT0("LM",NMSPC,FLAGHDR,"")
+8 SET XX=FLAG(52.41,ORD_",",35,"E")
+9 FOR
if XX=""
QUIT
Begin DoDot:1
+10 SET FLAGCOMM=" "_$$COMPARE^PSOERUT0("LM",$EXTRACT(XX,1,79),$EXTRACT(XX,1,79),2)
SET XX=$EXTRACT(XX,80,9999)
+11 DO ADDLINE^PSOERUT0("LM",NMSPC,FLAGCOMM,"")
End DoDot:1
+12 IF FLAG(52.41,ORD_",",36,"I")'=""
Begin DoDot:1
+13 SET XX="Order Un-Flagged by "_FLAG(52.41,ORD_",",37,"E")_" on "_FLAG(52.41,ORD_",",36,"E")
+14 SET FLAGHDR=""
SET $EXTRACT(FLAGHDR,(81-$LENGTH(XX))/2)=XX
+15 SET UNDERLN(LINE,1)=100
+16 DO ADDLINE^PSOERUT0("LM",NMSPC,FLAGHDR,"")
+17 SET XX=FLAG(52.41,ORD_",",38,"E")
+18 FOR
if XX=""
QUIT
Begin DoDot:2
+19 SET FLAGCOMM=$EXTRACT(XX,1,79)
+20 SET FLAGCOMM=" "_$$COMPARE^PSOERUT0("LM",$EXTRACT(XX,1,79),$EXTRACT(XX,1,79),2)
SET XX=$EXTRACT(XX,80,9999)
+21 DO ADDLINE^PSOERUT0("LM",NMSPC,FLAGCOMM,"")
End DoDot:2
End DoDot:1
+22 DO BLANKLN^PSOERUT0("LM",1)
+23 QUIT
+24 ;
ACCDTBY(ERXIEN) ; Returns the eRx latest Accepted Date/Time
+1 ; Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
+2 ;Output: P1^P2 - P1: External Accepted Date/Time (MM/DD/YY) | P2: Accepted By Name
+3 ;
+4 NEW ACCDTBY,ACDTTM,ACBY,STHIS,FOUND,STAT
+5 SET ACCDTBY=""
SET STHIS=99999
SET FOUND=0
+6 FOR
SET STHIS=$ORDER(^PS(52.49,ERXIEN,19,STHIS),-1)
if 'STHIS!(FOUND)
QUIT
Begin DoDot:1
+7 ; eRx was Un-Accepted
IF $$GET1^DIQ(52.4919,STHIS_","_ERXIEN,.04,"I")
SET FOUND=1
QUIT
+8 SET STAT=$$GET1^DIQ(52.4919,STHIS_","_ERXIEN,.02,"I")
+9 IF ",PR,RXP,CXP,"[(","_$$GET1^DIQ(52.45,STAT,.01,"E")_",")
Begin DoDot:2
+10 SET ACCDTBY=$$FMTE^XLFDT($$GET1^DIQ(52.4919,STHIS_","_ERXIEN,.01,"I"),"2Y")_"^"_$$GET1^DIQ(52.4919,STHIS_","_ERXIEN,.03,"E")
+11 SET FOUND=1
End DoDot:2
End DoDot:1
+12 QUIT ACCDTBY
+13 ;
PROVCOMM(COMM) ; Expand Provider Comments
+1 ; Input: Provider Comments
+2 ;Output: Expanded Comments
+3 NEW PROVCOMM,X,PSODIR,INS1
+4 IF $GET(COMM)=""
QUIT ""
+5 SET COMM=$$UP^XLFSTR(COMM)
+6 SET (X,PSODIR("INS"))=COMM
DO SIG^PSOHELP
SET $EXTRACT(INS1)=""
SET PROVCOMM=INS1
+7 QUIT PROVCOMM
+8 ;
FREQ(DUR) ; Returns the Duration Frequency word (WEEKS, DAYS, etc..)
+1 ; Input: DUR - Schedule Duration (e.g., "4D", "3W", "6H", etc...)
+2 ;Output: Spelled out duration frequency between parenthesis ("(DAYS)", "(WEEKS)", "(HOURS)", etc...)
+3 SET DUR=$GET(DUR)
+4 IF DUR["M"
QUIT "(MINUTES)"
+5 IF DUR["H"
QUIT "(HOURS)"
+6 IF DUR["L"
QUIT "(MONTHS)"
+7 IF DUR["W"
QUIT "(WEEKS)"
+8 QUIT "(DAYS)"
