- PSOERUT4 ;ALB/MFR - eRx Drug Suggestion Utilities; 06/25/2023 5:14pm
- ;;7.0;OUTPATIENT PHARMACY;**700,746,769**;DEC 1997;Build 26
- ;
- MATCHSUG(ERXIEN,VIEW) ; Match Suggestion Prompt
- ; Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
- ; (o)VIEW - View Only Mode (1:YES,0/null: NO)
- ;Output: MATCHSUG - eRx record (Pointer to #52.49) or 0 (Not selected or no suggestion on file)
- ;
- N MATCHSUG,DRUGHASH,MATCHCNT,CNT,VISTARX,QUIT,DIR,Y,X,VADRUG,VASIG,SUGGARR,TEMPARR,II
- N VADAYS,VAREFS,VAQTY
- I '$D(^PS(52.49,+$G(ERXIEN),0)) Q 0
- ; Dosage already entered
- I '$G(VIEW),$D(^PS(52.49,ERXIEN,21)) Q 0
- ;
- S DRUGHASH=$$DRUGHASH^PSOERUT(ERXIEN) I 'DRUGHASH Q 0
- ;
- S (MATCHSUG,MATCHCNT,QUIT)=0
- S VISTARX=9999999999
- F S VISTARX=$O(^PS(52.49,"ADRGVRX",DRUGHASH,VISTARX),-1) Q:'VISTARX D I (MATCHCNT>2) Q
- . S VADRUG=+$$GET1^DIQ(52,VISTARX,6,"I") I 'VADRUG Q
- . ; If in View Mode and VistA Rx was created after eRx Drug was Validated, skip
- . I $G(VIEW),$P($G(^PS(52.49,ERXIEN,1)),"^",12),$P($G(^PSRX(VISTARX,"OR1")),"^",8)>+$P($G(^PS(52.49,ERXIEN,1)),"^",12) Q
- . ; If Drug is Inactive, forget suggestion automatically
- . I $$GET1^DIQ(50,VADRUG,100,"I") D Q
- . . K ^PS(52.49,"ADRGVRX",DRUGHASH,VISTARX)
- . S VASIG=$E($$SUGSIG^PSOERUT3(VISTARX,ERXIEN),1,500) I VASIG="" Q
- . S VAQTY=+$$GET1^DIQ(52,VISTARX,7,"I")
- . S VADAYS=+$$GET1^DIQ(52,VISTARX,8,"I")
- . S VAREFS=+$$GET1^DIQ(52,VISTARX,9,"I")
- . I $D(TEMPARR(VADRUG,VASIG,VAQTY,VADAYS,VAREFS)) Q
- . S MATCHCNT=MATCHCNT+1
- . S SUGGARR(MATCHCNT)=VISTARX_"^"_DRUGHASH,TEMPARR(VADRUG,VASIG,VAQTY,VADAYS,VAREFS)=""
- F CNT=1:1:MATCHCNT D I MATCHSUG!QUIT Q
- . S VISTARX=+SUGGARR(CNT),DRUGHASH=$P(SUGGARR(CNT),"^",2)
- . D CMPMEDS(ERXIEN,VISTARX,CNT_"^"_MATCHCNT)
- . K DIR S DIR(0)="SOA^"_$S('$G(VIEW):"A:ACCEPT;",1:"")_$S(MATCHCNT>1&(MATCHCNT'=CNT):"N:NEXT;",1:"")_"F:FORGET;E:EXIT"
- . S DIR("A")="ACTION on SUGGESTION: "_$S('$G(VIEW):"(A)CCEPT ",1:"")_$S(MATCHCNT>1&(MATCHCNT'=CNT):"(N)EXT ",1:"")_"(F)ORGET (E)XIT: "
- . S DIR("B")=$S(MATCHCNT>1&(MATCHCNT'=CNT):"NEXT",1:"EXIT")
- . S II=0
- . I '$G(VIEW) D
- . . S II=II+1,DIR("?",II)=" ACCEPT - Accepts the suggested data (right column) and pre-populates the"
- . . S II=II+1,DIR("?",II)=" VistA fields"
- . I MATCHCNT>1&(MATCHCNT'=CNT) D
- . . S II=II+1,DIR("?",II)=" NEXT - Ignores the current suggestion and view the next one"
- . S II=II+1,DIR("?",II)=" FORGET - Forgets the current suggestion so that it is not presented again"
- . S II=II+1,DIR("?",II)=" in the future to any user"
- . S DIR("?")=" EXIT - Exits and continue to filling the VistA fields manually"
- . D ^DIR I $D(DIRUT)!$D(DIROUT)!(Y="E") S QUIT=1 Q
- . I Y="A" S MATCHSUG=VISTARX Q
- . I Y="N" W ! Q
- . I Y="F" D
- . . K DIR S DIR(0)="SA^Y:YES;N:NO",DIR("B")="NO"
- . . S DIR("A")="Are you sure this suggestion match should be forgotten? "
- . . S DIR("?")="This suggestion originated from a VistA Rx previously dispensed for an eRx with"
- . . S DIR("?")=DIR("?")_" the exact Drug Name, NDC, SIG, Quantity, Days Supply, # of Refills"
- . . S DIR("?")=DIR("?")_" and Substitution allowance. Once you forget this match it will no"
- . . S DIR("?")=DIR("?")_" longer be suggested as a match for future eRx's with the same fields."
- . . W ! D ^DIR I $D(DIRUT)!$D(DIROUT)!(Y="N") S CNT=CNT-1 W ! Q
- . . W !?64,"Forgetting..." K ^PS(52.49,"ADRGVRX",DRUGHASH,VISTARX) H 1 W "Ok." H .5 W ! Q
- Q MATCHSUG
- ;
- CMPMEDS(ERXIEN,VISTARX,COUNTER) ; Display the Comparison Between eRx and VistA Providers
- ;Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
- ; VISTARX - VistA Rx IEN (Pointer to #52)
- ; COUNTER - P1: Entry # | P2: Number of Entries
- I '$D(^PS(52.49,+$G(ERXIEN),0))!'$D(^PSRX(+$G(VISTARX),0)) Q
- N XX,LINE,X
- W !?55,"|Sugg. " W $G(IOINHI)_+$G(COUNTER)_$G(IOINORM)_" of "_$G(IOINHI)_$P($G(COUNTER),"^",2)_$G(IOINORM)
- W " - ",$G(IOINHI)_$$FMTE^XLFDT($$GET1^DIQ(52,VISTARX,21,"I")\1,"2Z")_$G(IOINORM),?79,"|"
- W !,$G(IORVON)_"ERX MED"_$G(IORVOFF),?41,$G(IORVON)_"VISTA MED"_$G(IORVOFF)
- W ?55,"|From Rx#: "_$G(IOINHI)_$$GET1^DIQ(52,VISTARX,.01)_$G(IOINORM),?79,"|"
- S $P(XX,"_",81)="" W !,XX
- S LINE=0 D SETDRUG^PSOERUT2("RS",,ERXIEN,1,VISTARX)
- Q
- ;
- 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,ALLLN,ERXALLS
- 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)
- ;
- ; - Setting eRx Prescriber Drug Use Evaluation (DUE), Matched Dosage and Patient Instructions
- 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 $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=$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,"")
- 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
- . 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 17241 printed Jan 18, 2025@03:29:14 Page 2
- PSOERUT4 ;ALB/MFR - eRx Drug Suggestion Utilities; 06/25/2023 5:14pm
- +1 ;;7.0;OUTPATIENT PHARMACY;**700,746,769**;DEC 1997;Build 26
- +2 ;
- MATCHSUG(ERXIEN,VIEW) ; Match Suggestion Prompt
- +1 ; Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
- +2 ; (o)VIEW - View Only Mode (1:YES,0/null: NO)
- +3 ;Output: MATCHSUG - eRx record (Pointer to #52.49) or 0 (Not selected or no suggestion on file)
- +4 ;
- +5 NEW MATCHSUG,DRUGHASH,MATCHCNT,CNT,VISTARX,QUIT,DIR,Y,X,VADRUG,VASIG,SUGGARR,TEMPARR,II
- +6 NEW VADAYS,VAREFS,VAQTY
- +7 IF '$DATA(^PS(52.49,+$GET(ERXIEN),0))
- QUIT 0
- +8 ; Dosage already entered
- +9 IF '$GET(VIEW)
- IF $DATA(^PS(52.49,ERXIEN,21))
- QUIT 0
- +10 ;
- +11 SET DRUGHASH=$$DRUGHASH^PSOERUT(ERXIEN)
- IF 'DRUGHASH
- QUIT 0
- +12 ;
- +13 SET (MATCHSUG,MATCHCNT,QUIT)=0
- +14 SET VISTARX=9999999999
- +15 FOR
- SET VISTARX=$ORDER(^PS(52.49,"ADRGVRX",DRUGHASH,VISTARX),-1)
- if 'VISTARX
- QUIT
- Begin DoDot:1
- +16 SET VADRUG=+$$GET1^DIQ(52,VISTARX,6,"I")
- IF 'VADRUG
- QUIT
- +17 ; If in View Mode and VistA Rx was created after eRx Drug was Validated, skip
- +18 IF $GET(VIEW)
- IF $PIECE($GET(^PS(52.49,ERXIEN,1)),"^",12)
- IF $PIECE($GET(^PSRX(VISTARX,"OR1")),"^",8)>+$PIECE($GET(^PS(52.49,ERXIEN,1)),"^",12)
- QUIT
- +19 ; If Drug is Inactive, forget suggestion automatically
- +20 IF $$GET1^DIQ(50,VADRUG,100,"I")
- Begin DoDot:2
- +21 KILL ^PS(52.49,"ADRGVRX",DRUGHASH,VISTARX)
- End DoDot:2
- QUIT
- +22 SET VASIG=$EXTRACT($$SUGSIG^PSOERUT3(VISTARX,ERXIEN),1,500)
- IF VASIG=""
- QUIT
- +23 SET VAQTY=+$$GET1^DIQ(52,VISTARX,7,"I")
- +24 SET VADAYS=+$$GET1^DIQ(52,VISTARX,8,"I")
- +25 SET VAREFS=+$$GET1^DIQ(52,VISTARX,9,"I")
- +26 IF $DATA(TEMPARR(VADRUG,VASIG,VAQTY,VADAYS,VAREFS))
- QUIT
- +27 SET MATCHCNT=MATCHCNT+1
- +28 SET SUGGARR(MATCHCNT)=VISTARX_"^"_DRUGHASH
- SET TEMPARR(VADRUG,VASIG,VAQTY,VADAYS,VAREFS)=""
- End DoDot:1
- IF (MATCHCNT>2)
- QUIT
- +29 FOR CNT=1:1:MATCHCNT
- Begin DoDot:1
- +30 SET VISTARX=+SUGGARR(CNT)
- SET DRUGHASH=$PIECE(SUGGARR(CNT),"^",2)
- +31 DO CMPMEDS(ERXIEN,VISTARX,CNT_"^"_MATCHCNT)
- +32 KILL DIR
- SET DIR(0)="SOA^"_$SELECT('$GET(VIEW):"A:ACCEPT;",1:"")_$SELECT(MATCHCNT>1&(MATCHCNT'=CNT):"N:NEXT;",1:"")_"F:FORGET;E:EXIT"
- +33 SET DIR("A")="ACTION on SUGGESTION: "_$SELECT('$GET(VIEW):"(A)CCEPT ",1:"")_$SELECT(MATCHCNT>1&(MATCHCNT'=CNT):"(N)EXT ",1:"")_"(F)ORGET (E)XIT: "
- +34 SET DIR("B")=$SELECT(MATCHCNT>1&(MATCHCNT'=CNT):"NEXT",1:"EXIT")
- +35 SET II=0
- +36 IF '$GET(VIEW)
- Begin DoDot:2
- +37 SET II=II+1
- SET DIR("?",II)=" ACCEPT - Accepts the suggested data (right column) and pre-populates the"
- +38 SET II=II+1
- SET DIR("?",II)=" VistA fields"
- End DoDot:2
- +39 IF MATCHCNT>1&(MATCHCNT'=CNT)
- Begin DoDot:2
- +40 SET II=II+1
- SET DIR("?",II)=" NEXT - Ignores the current suggestion and view the next one"
- End DoDot:2
- +41 SET II=II+1
- SET DIR("?",II)=" FORGET - Forgets the current suggestion so that it is not presented again"
- +42 SET II=II+1
- SET DIR("?",II)=" in the future to any user"
- +43 SET DIR("?")=" EXIT - Exits and continue to filling the VistA fields manually"
- +44 DO ^DIR
- IF $DATA(DIRUT)!$DATA(DIROUT)!(Y="E")
- SET QUIT=1
- QUIT
- +45 IF Y="A"
- SET MATCHSUG=VISTARX
- QUIT
- +46 IF Y="N"
- WRITE !
- QUIT
- +47 IF Y="F"
- Begin DoDot:2
- +48 KILL DIR
- SET DIR(0)="SA^Y:YES;N:NO"
- SET DIR("B")="NO"
- +49 SET DIR("A")="Are you sure this suggestion match should be forgotten? "
- +50 SET DIR("?")="This suggestion originated from a VistA Rx previously dispensed for an eRx with"
- +51 SET DIR("?")=DIR("?")_" the exact Drug Name, NDC, SIG, Quantity, Days Supply, # of Refills"
- +52 SET DIR("?")=DIR("?")_" and Substitution allowance. Once you forget this match it will no"
- +53 SET DIR("?")=DIR("?")_" longer be suggested as a match for future eRx's with the same fields."
- +54 WRITE !
- DO ^DIR
- IF $DATA(DIRUT)!$DATA(DIROUT)!(Y="N")
- SET CNT=CNT-1
- WRITE !
- QUIT
- +55 WRITE !?64,"Forgetting..."
- KILL ^PS(52.49,"ADRGVRX",DRUGHASH,VISTARX)
- HANG 1
- WRITE "Ok."
- HANG .5
- WRITE !
- QUIT
- End DoDot:2
- End DoDot:1
- IF MATCHSUG!QUIT
- QUIT
- +56 QUIT MATCHSUG
- +57 ;
- CMPMEDS(ERXIEN,VISTARX,COUNTER) ; Display the Comparison Between eRx and VistA Providers
- +1 ;Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
- +2 ; VISTARX - VistA Rx IEN (Pointer to #52)
- +3 ; COUNTER - P1: Entry # | P2: Number of Entries
- +4 IF '$DATA(^PS(52.49,+$GET(ERXIEN),0))!'$DATA(^PSRX(+$GET(VISTARX),0))
- QUIT
- +5 NEW XX,LINE,X
- +6 WRITE !?55,"|Sugg. "
- WRITE $GET(IOINHI)_+$GET(COUNTER)_$GET(IOINORM)_" of "_$GET(IOINHI)_$PIECE($GET(COUNTER),"^",2)_$GET(IOINORM)
- +7 WRITE " - ",$GET(IOINHI)_$$FMTE^XLFDT($$GET1^DIQ(52,VISTARX,21,"I")\1,"2Z")_$GET(IOINORM),?79,"|"
- +8 WRITE !,$GET(IORVON)_"ERX MED"_$GET(IORVOFF),?41,$GET(IORVON)_"VISTA MED"_$GET(IORVOFF)
- +9 WRITE ?55,"|From Rx#: "_$GET(IOINHI)_$$GET1^DIQ(52,VISTARX,.01)_$GET(IOINORM),?79,"|"
- +10 SET $PIECE(XX,"_",81)=""
- WRITE !,XX
- +11 SET LINE=0
- DO SETDRUG^PSOERUT2("RS",,ERXIEN,1,VISTARX)
- +12 QUIT
- +13 ;
- 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,ALLLN,ERXALLS
- +6 SET DFN=+$$GET1^DIQ(52.41,ORDIEN,1,"I")
- +7 ;
- +8 DO PDUEDATA^PSOERXU9(.PDUE,ERXIEN,1)
- +9 SET XEI=0
- SET LMLINE=LINE-1
- +10 SET XEI=XEI+1
- SET LMLINE=LMLINE+1
- SET ERXLINES(XEI)="Prescriber Drug Use Evaluation:"
- +11 IF '$DATA(PDUE)
- Begin DoDot:1
- +12 SET XEI=XEI+1
- SET LMLINE=LMLINE+1
- SET ERXLINES(XEI)=" None"
- SET HIGHLN(LMLINE,2)=4
- End DoDot:1
- +13 IF '$TEST
- Begin DoDot:1
- +14 FOR DUESEQ=1:1
- if '$DATA(PDUE(DUESEQ))
- QUIT
- Begin DoDot:2
- +15 SET COAGENT=$PIECE(PDUE(DUESEQ),"^",8)
- +16 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)
- +17 IF $LENGTH(COAGENT)>29
- Begin DoDot:3
- +18 FOR I=1:1
- SET COAGENT=$EXTRACT(COAGENT,30,999)
- if COAGENT=""
- QUIT
- Begin DoDot:4
- +19 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
- +20 SET REASON=$PIECE(PDUE(DUESEQ),"^",2)
- IF $$PRESOLV^PSOERXA1(REASON,"REA")
- SET REASON=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(REASON,"REA"),.02)
- +21 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)
- +22 IF $LENGTH(REASON)>31
- Begin DoDot:3
- +23 FOR I=1:1
- SET REASON=$EXTRACT(REASON,32,999)
- if REASON=""
- QUIT
- Begin DoDot:4
- +24 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
- +25 SET RESULT=$PIECE(PDUE(DUESEQ),"^",4)
- IF $$PRESOLV^PSOERXA1(RESULT,"RES")
- SET RESULT=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(RESULT,"RES"),.02)
- +26 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)
- +27 IF $LENGTH(RESULT)>31
- Begin DoDot:3
- +28 FOR I=1:1
- SET RESULT=$EXTRACT(RESULT,32,999)
- if RESULT=""
- QUIT
- Begin DoDot:4
- +29 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
- +30 SET ACK=$PIECE(PDUE(DUESEQ),"^",9)
- +31 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)
- +32 IF $LENGTH(ACK)>29
- Begin DoDot:3
- +33 FOR I=1:1
- SET ACK=$EXTRACT(ACK,30,999)
- if ACK=""
- QUIT
- Begin DoDot:4
- +34 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
- +35 IF $ORDER(PDUE(DUESEQ))
- SET XEI=XEI+1
- SET LMLINE=LMLINE+1
- SET ERXLINES(XEI)="......................................"
- End DoDot:2
- End DoDot:1
- +36 ;
- +37 SET XVI=0
- SET LMLINE=LINE-1
- +38 IF '$DATA(PENDATA)
- Begin DoDot:1
- +39 SET XVI=XVI+1
- SET LMLINE=LMLINE+1
- SET VALINES(XVI)=$SELECT('RENEWORD:"3) ",1:" ")_" *Dosage:"
- End DoDot:1
- QUIT
- +40 FOR DOSE=1:1
- if '$DATA(PENDATA("DOSE",DOSE))
- QUIT
- Begin DoDot:1
- +41 IF '$GET(PENDATA("DOSE ORDERED",DOSE))
- IF $GET(PENDATA("VERB",DOSE))]""
- Begin DoDot:2
- +42 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
- +43 SET DOSEX=PENDATA("DOSE",DOSE)
- IF $EXTRACT(DOSEX,1)="."
- IF $GET(PENDATA("DOSE ORDERED",DOSE))
- SET DOSEX="0"_DOSEX
- +44 IF $GET(PENDATA("UNITS",DOSE))]""
- SET DOSEX=DOSEX_" ("_$$GET1^DIQ(50.607,PENDATA("UNITS",DOSE),.01)_")"
- +45 DO WRAP^PSOERUT(DOSEX,24,.WRPDOSE)
- +46 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)
- +47 IF DOSE=1
- IF 'RENEWORD
- SET UNDERLN(LMLINE,41)=2
- +48 FOR I=2:1
- if '$DATA(WRPDOSE(I))
- QUIT
- Begin DoDot:2
- +49 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
- +50 IF $GET(PENDATA("DOSE ORDERED",DOSE))
- IF $GET(PENDATA("VERB",DOSE))]""
- Begin DoDot:2
- +51 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
- +52 IF '$GET(PENDATA("DOSE ORDERED",DOSE))
- IF $PIECE($GET(^PS(55,DFN,"LAN")),"^")
- Begin DoDot:2
- +53 DO WRAP^PSOERUT($GET(PENDATA("ODOSE",DOSE)),22,.WRPDOSE)
- +54 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)
- +55 FOR I=2:1
- if '$DATA(WRPDOSE(I))
- QUIT
- Begin DoDot:3
- +56 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
- +57 IF $GET(PENDATA("DOSE ORDERED",DOSE))'=""
- Begin DoDot:2
- +58 SET DISPUNTS=$SELECT($EXTRACT(PENDATA("DOSE ORDERED",DOSE),1)=".":"0",1:"")_PENDATA("DOSE ORDERED",DOSE)
- +59 SET XVI=XVI+1
- SET LMLINE=LMLINE+1
- SET VALINES(XVI)=" Disp. Units: "_$$COMPARE^PSOERUT0("LM",DISPUNTS,DISPUNTS,55,,LMLINE)
- End DoDot:2
- +60 IF $GET(PENDATA("NOUN",DOSE))'=""
- Begin DoDot:2
- +61 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
- +62 IF $GET(PENDATA("ROUTE",DOSE))
- SET ROUTE=$$GET1^DIQ(51.2,PENDATA("ROUTE",DOSE),.01)
- +63 SET XVI=XVI+1
- SET LMLINE=LMLINE+1
- SET VALINES(XVI)=" *Route: "_$$COMPARE^PSOERUT0("LM",$GET(ROUTE),$GET(ROUTE),55,,LMLINE)
- +64 SET XVI=XVI+1
- SET LMLINE=LMLINE+1
- SET VALINES(XVI)=" *Schedule: "_$$COMPARE^PSOERUT0("LM",PENDATA("SCHEDULE",DOSE),PENDATA("SCHEDULE",DOSE),55,,LMLINE)
- +65 IF $GET(PENDATA("DURATION",DOSE))'=""
- Begin DoDot:2
- +66 NEW DUR
- SET DUR=PENDATA("DURATION",DOSE)
- +67 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
- +68 IF $GET(PENDATA("CONJUNCTION",DOSE))'=""
- Begin DoDot:2
- +69 SET CONJUNCT=$SELECT(PENDATA("CONJUNCTION",DOSE)="T":"THEN",PENDATA("CONJUNCTION",DOSE)="X":"EXCEPT",1:"AND")
- +70 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
- +71 ;
- +72 ; - Patient Instructions
- +73 SET XVI=XVI+1
- SET LMLINE=LMLINE+1
- SET VALINES(XVI)="________________________________________"
- +74 SET XVI=XVI+1
- SET LMLINE=LMLINE+1
- SET VALINES(XVI)=$SELECT('RENEWORD:"4) ",1:"")_"Patient Instruction:"
- +75 IF 'RENEWORD
- SET UNDERLN(LMLINE,41)=2
- +76 SET VAPATINS=""
- FOR I=1:1
- if '$DATA(PENDATA("SIG",I))
- QUIT
- SET VAPATINS=VAPATINS_" "_$$UP^XLFSTR($GET(PENDATA("SIG",I)))
- +77 SET $EXTRACT(VAPATINS)=""
- +78 IF VAPATINS'=""
- Begin DoDot:1
- +79 KILL VARR
- DO WRAP^PSOERUT(VAPATINS,39,.VARR)
- +80 FOR I=1:1
- if '$DATA(VARR(I))
- QUIT
- Begin DoDot:2
- +81 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
- +82 IF $ORDER(PENDATA("SINS",0))
- Begin DoDot:1
- +83 SET XVI=XVI+1
- SET LMLINE=LMLINE+1
- SET VALINES(XVI)=" Other Lang. Pat. Instruct: :"
- +84 SET VAOTHINS=""
- FOR I=1:1
- if '$DATA(PENDATA("SINS",I))
- QUIT
- SET VAOTHINS=VAOTHINS_" "_$$UP^XLFSTR($GET(PENDATA("SINS",I)))
- +85 SET $EXTRACT(VAOTHINS)=""
- +86 KILL VARR
- DO WRAP^PSOERUT(VAOTHINS,39,.VARR)
- +87 FOR I=1:1
- if '$DATA(VARR(I))
- QUIT
- Begin DoDot:2
- +88 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
- +89 ;
- +90 ; - Setting eRx Prescriber Drug Use Evaluation (DUE), Matched Dosage and Patient Instructions
- +91 FOR ALLLN=1:1
- if ('$DATA(ERXLINES(ALLLN))&'$DATA(VALINES(ALLLN)))
- QUIT
- Begin DoDot:1
- +92 SET ERXALLS=$GET(ERXLINES(ALLLN))
- SET VAALLS=$GET(VALINES(ALLLN))
- +93 SET XE=$GET(ERXLINES(ALLLN))
- +94 SET XV="|"_$GET(VALINES(ALLLN))
- +95 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
- End DoDot:1
- +96 ;
- +97 QUIT
- +98 ;
- 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 $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=$EXTRACT(XX,1,79)
- +11 SET FLAGCOMM=" "_$$COMPARE^PSOERUT0("LM",$EXTRACT(XX,1,79),$EXTRACT(XX,1,79),2)
- SET XX=$EXTRACT(XX,80,9999)
- +12 DO ADDLINE^PSOERUT0("LM",NMSPC,FLAGCOMM,"")
- End DoDot:1
- +13 IF FLAG(52.41,ORD_",",36,"I")'=""
- Begin DoDot:1
- +14 SET XX="Order Un-Flagged by "_FLAG(52.41,ORD_",",37,"E")_" on "_FLAG(52.41,ORD_",",36,"E")
- +15 SET FLAGHDR=""
- SET $EXTRACT(FLAGHDR,(81-$LENGTH(XX))/2)=XX
- +16 SET UNDERLN(LINE,1)=100
- +17 DO ADDLINE^PSOERUT0("LM",NMSPC,FLAGHDR,"")
- +18 SET XX=FLAG(52.41,ORD_",",38,"E")
- +19 FOR
- if XX=""
- QUIT
- Begin DoDot:2
- +20 SET FLAGCOMM=$EXTRACT(XX,1,79)
- +21 SET FLAGCOMM=" "_$$COMPARE^PSOERUT0("LM",$EXTRACT(XX,1,79),$EXTRACT(XX,1,79),2)
- SET XX=$EXTRACT(XX,80,9999)
- +22 DO ADDLINE^PSOERUT0("LM",NMSPC,FLAGCOMM,"")
- End DoDot:2
- End DoDot:1
- +23 DO BLANKLN^PSOERUT0("LM",1)
- +24 QUIT
- +25 ;
- 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 SET STAT=$$GET1^DIQ(52.4919,STHIS_","_ERXIEN,.02,"I")
- +8 IF ",PR,RXP,CXP,"[(","_$$GET1^DIQ(52.45,STAT,.01,"E")_",")
- Begin DoDot:2
- +9 SET ACCDTBY=$$FMTE^XLFDT($$GET1^DIQ(52.4919,STHIS_","_ERXIEN,.01,"I"),"2Y")_"^"_$$GET1^DIQ(52.4919,STHIS_","_ERXIEN,.03,"E")
- +10 SET FOUND=1
- End DoDot:2
- End DoDot:1
- +11 QUIT ACCDTBY
- +12 ;
- 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)"