Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOERUT4

PSOERUT4.m

Go to the documentation of this file.
  1. PSOERUT4 ;ALB/MFR - eRx Drug Suggestion Utilities; 06/25/2023 5:14pm
  1. ;;7.0;OUTPATIENT PHARMACY;**700,746,769**;DEC 1997;Build 26
  1. ;
  1. MATCHSUG(ERXIEN,VIEW) ; Match Suggestion Prompt
  1. ; Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
  1. ; (o)VIEW - View Only Mode (1:YES,0/null: NO)
  1. ;Output: MATCHSUG - eRx record (Pointer to #52.49) or 0 (Not selected or no suggestion on file)
  1. ;
  1. N MATCHSUG,DRUGHASH,MATCHCNT,CNT,VISTARX,QUIT,DIR,Y,X,VADRUG,VASIG,SUGGARR,TEMPARR,II
  1. N VADAYS,VAREFS,VAQTY
  1. I '$D(^PS(52.49,+$G(ERXIEN),0)) Q 0
  1. ; Dosage already entered
  1. I '$G(VIEW),$D(^PS(52.49,ERXIEN,21)) Q 0
  1. ;
  1. S DRUGHASH=$$DRUGHASH^PSOERUT(ERXIEN) I 'DRUGHASH Q 0
  1. ;
  1. S (MATCHSUG,MATCHCNT,QUIT)=0
  1. S VISTARX=9999999999
  1. F S VISTARX=$O(^PS(52.49,"ADRGVRX",DRUGHASH,VISTARX),-1) Q:'VISTARX D I (MATCHCNT>2) Q
  1. . S VADRUG=+$$GET1^DIQ(52,VISTARX,6,"I") I 'VADRUG Q
  1. . ; If in View Mode and VistA Rx was created after eRx Drug was Validated, skip
  1. . 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
  1. . ; If Drug is Inactive, forget suggestion automatically
  1. . I $$GET1^DIQ(50,VADRUG,100,"I") D Q
  1. . . K ^PS(52.49,"ADRGVRX",DRUGHASH,VISTARX)
  1. . S VASIG=$E($$SUGSIG^PSOERUT3(VISTARX,ERXIEN),1,500) I VASIG="" Q
  1. . S VAQTY=+$$GET1^DIQ(52,VISTARX,7,"I")
  1. . S VADAYS=+$$GET1^DIQ(52,VISTARX,8,"I")
  1. . S VAREFS=+$$GET1^DIQ(52,VISTARX,9,"I")
  1. . I $D(TEMPARR(VADRUG,VASIG,VAQTY,VADAYS,VAREFS)) Q
  1. . S MATCHCNT=MATCHCNT+1
  1. . S SUGGARR(MATCHCNT)=VISTARX_"^"_DRUGHASH,TEMPARR(VADRUG,VASIG,VAQTY,VADAYS,VAREFS)=""
  1. F CNT=1:1:MATCHCNT D I MATCHSUG!QUIT Q
  1. . S VISTARX=+SUGGARR(CNT),DRUGHASH=$P(SUGGARR(CNT),"^",2)
  1. . D CMPMEDS(ERXIEN,VISTARX,CNT_"^"_MATCHCNT)
  1. . K DIR S DIR(0)="SOA^"_$S('$G(VIEW):"A:ACCEPT;",1:"")_$S(MATCHCNT>1&(MATCHCNT'=CNT):"N:NEXT;",1:"")_"F:FORGET;E:EXIT"
  1. . S DIR("A")="ACTION on SUGGESTION: "_$S('$G(VIEW):"(A)CCEPT ",1:"")_$S(MATCHCNT>1&(MATCHCNT'=CNT):"(N)EXT ",1:"")_"(F)ORGET (E)XIT: "
  1. . S DIR("B")=$S(MATCHCNT>1&(MATCHCNT'=CNT):"NEXT",1:"EXIT")
  1. . S II=0
  1. . I '$G(VIEW) D
  1. . . S II=II+1,DIR("?",II)=" ACCEPT - Accepts the suggested data (right column) and pre-populates the"
  1. . . S II=II+1,DIR("?",II)=" VistA fields"
  1. . I MATCHCNT>1&(MATCHCNT'=CNT) D
  1. . . S II=II+1,DIR("?",II)=" NEXT - Ignores the current suggestion and view the next one"
  1. . S II=II+1,DIR("?",II)=" FORGET - Forgets the current suggestion so that it is not presented again"
  1. . S II=II+1,DIR("?",II)=" in the future to any user"
  1. . S DIR("?")=" EXIT - Exits and continue to filling the VistA fields manually"
  1. . D ^DIR I $D(DIRUT)!$D(DIROUT)!(Y="E") S QUIT=1 Q
  1. . I Y="A" S MATCHSUG=VISTARX Q
  1. . I Y="N" W ! Q
  1. . I Y="F" D
  1. . . K DIR S DIR(0)="SA^Y:YES;N:NO",DIR("B")="NO"
  1. . . S DIR("A")="Are you sure this suggestion match should be forgotten? "
  1. . . S DIR("?")="This suggestion originated from a VistA Rx previously dispensed for an eRx with"
  1. . . S DIR("?")=DIR("?")_" the exact Drug Name, NDC, SIG, Quantity, Days Supply, # of Refills"
  1. . . S DIR("?")=DIR("?")_" and Substitution allowance. Once you forget this match it will no"
  1. . . S DIR("?")=DIR("?")_" longer be suggested as a match for future eRx's with the same fields."
  1. . . W ! D ^DIR I $D(DIRUT)!$D(DIROUT)!(Y="N") S CNT=CNT-1 W ! Q
  1. . . W !?64,"Forgetting..." K ^PS(52.49,"ADRGVRX",DRUGHASH,VISTARX) H 1 W "Ok." H .5 W ! Q
  1. Q MATCHSUG
  1. ;
  1. CMPMEDS(ERXIEN,VISTARX,COUNTER) ; Display the Comparison Between eRx and VistA Providers
  1. ;Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
  1. ; VISTARX - VistA Rx IEN (Pointer to #52)
  1. ; COUNTER - P1: Entry # | P2: Number of Entries
  1. I '$D(^PS(52.49,+$G(ERXIEN),0))!'$D(^PSRX(+$G(VISTARX),0)) Q
  1. N XX,LINE,X
  1. W !?55,"|Sugg. " W $G(IOINHI)_+$G(COUNTER)_$G(IOINORM)_" of "_$G(IOINHI)_$P($G(COUNTER),"^",2)_$G(IOINORM)
  1. W " - ",$G(IOINHI)_$$FMTE^XLFDT($$GET1^DIQ(52,VISTARX,21,"I")\1,"2Z")_$G(IOINORM),?79,"|"
  1. W !,$G(IORVON)_"ERX MED"_$G(IORVOFF),?41,$G(IORVON)_"VISTA MED"_$G(IORVOFF)
  1. W ?55,"|From Rx#: "_$G(IOINHI)_$$GET1^DIQ(52,VISTARX,.01)_$G(IOINORM),?79,"|"
  1. S $P(XX,"_",81)="" W !,XX
  1. S LINE=0 D SETDRUG^PSOERUT2("RS",,ERXIEN,1,VISTARX)
  1. Q
  1. ;
  1. CSPRV(PROV,DRG,ORN) ; Sets CS Information (DEA#, Detox #, Site Address,...)
  1. N DETN,DEA,I,LBL,VADD,SPC
  1. I PROV="" Q
  1. S:$L($G(PSORX("RXDEA"))) DEA=PSORX("RXDEA")
  1. I '$L($G(DEA)) D
  1. . S DEA=$S($G(PENDATA("OIRXN")):$$RXDEA^PSOUTIL(PENDATA("OIRXN")),$G(ORN):$$RXDEA^PSOUTIL(,ORN),1:$$DEA^XUSER(0,PROV))
  1. . S:DEA]"" PSORX("RXDEA")=DEA
  1. S:$L($G(PSORX("DETX"))) DETN=PSORX("DETX")
  1. S LBL="DEA#: "
  1. I DRG,$$DETOX^PSSOPKI(DRG),'$L($G(DETN)) D
  1. . S DETN=$S($G(ORN):$$RXDETOX^PSOUTIL(,ORN),1:$$DETOX^XUSER(PROV))
  1. S $P(SPC," ",(33-$L(DEA)))=" "
  1. I (DEA'="")!($G(DETN)'="") D
  1. . S XV="|"_LBL_$$COMPARE^PSOERUT0("LM",DEA,DEA,41+$L(LBL))
  1. . S XV=XV_$S($G(DETN)]"":SPC_"DETOX#: "_$$COMPARE^PSOERUT0("LM",$G(DETN),$G(DETN),49+$L(SPC)),1:"")
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
  1. I $G(ORN) D PRVAD^PSOPKIV2 I $G(VADD(1))]"" D
  1. . S XV="|Site Address: "_$$COMPARE^PSOERUT0("LM",VADD(1),VADD(1),15)
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
  1. . I VADD(2)'="" S XV="| "_$$COMPARE^PSOERUT0("LM",VADD(2),VADD(2),15)
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
  1. . I VADD(3)'="" S XV="| "_$$COMPARE^PSOERUT0("LM",VADD(3),VADD(3),15)
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
  1. Q
  1. ;
  1. VASIG(ORD) ; Returns The Pending Order SIG
  1. ; Input: ORD - Pointer to the PENDING ORDER file (#52.41)
  1. ;Output: VASIG - VistA SIG in one long string
  1. N VASIG,SIG
  1. S VASIG="",ORD=+$G(ORD)
  1. S SIG=0 F S SIG=$O(^PS(52.41,ORD,"SIG",SIG)) Q:'SIG D
  1. . I $E(VASIG,$L(VASIG))'=" " S VASIG=VASIG_" "
  1. . S VASIG=VASIG_$G(^PS(52.41,ORD,"SIG",SIG,0))
  1. Q VASIG
  1. ;
  1. 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)
  1. ; (o)INTVAL - 1: Use Internal Value Flag | 0/null: External Value
  1. ;Output:.DOSEARR - Return Array Containing Dosage Information
  1. ;
  1. N ERXDOSE,DOSE
  1. K DOSEARR D GETS^DIQ(52.49,ERXIEN,"21*","IE","ERXDOSE")
  1. S DOSE="" F S DOSE=$O(ERXDOSE(52.4921,DOSE)) Q:DOSE="" D
  1. . S DOSEARR("DOSE ORDERED",+DOSE)=ERXDOSE(52.4921,DOSE,9,"I")
  1. . S DOSEARR("DOSE",+DOSE)=ERXDOSE(52.4921,DOSE,8,"I")
  1. . S DOSEARR("UNITS",+DOSE)=ERXDOSE(52.4921,DOSE,11,"I")
  1. . S DOSEARR("NOUN",+DOSE)=ERXDOSE(52.4921,DOSE,12,"I")
  1. . S DOSEARR("DURATION",+DOSE)=ERXDOSE(52.4921,DOSE,2,"I")
  1. . I $G(ERXDOSE(52.4921,DOSE,6,$S($G(INTVAL):"I",1:"E")))'="" D
  1. . . S DOSEARR("CONJUNCTION",+DOSE)=ERXDOSE(52.4921,DOSE,6,$S($G(INTVAL):"I",1:"E"))
  1. . S DOSEARR("ROUTE",+DOSE)=ERXDOSE(52.4921,DOSE,10,$S($G(INTVAL):"I",1:"E"))
  1. . S DOSEARR("SCHEDULE",+DOSE)=ERXDOSE(52.4921,DOSE,1,"I")
  1. . S DOSEARR("VERB",+DOSE)=ERXDOSE(52.4921,DOSE,13,"I")
  1. Q
  1. ;
  1. VARXDOSE(RXIEN,DOSEARR) ; Retrieves the Dosage for a PRESCRIPTION and loads an Array
  1. ; Input: RXIEN - Pointer to the PRESCRIPTION file (#52)
  1. ;Output: .DOSEARR - Return Array Containing Dosage Information
  1. ;
  1. ; - Retrieving VistA Rx Dose and Saving to the eRx
  1. N VADOSE,DOSE
  1. I '$D(^PSRX(+$G(RXIEN),0)) Q
  1. K DOSEARR D GETS^DIQ(52,RXIEN,"113*","I","VADOSE")
  1. S DOSE="" F S DOSE=$O(VADOSE(52.0113,DOSE)) Q:DOSE="" D
  1. . S DOSEARR("DOSE ORDERED",+DOSE)=VADOSE(52.0113,DOSE,1,"I")
  1. . S DOSEARR("DOSE",+DOSE)=VADOSE(52.0113,DOSE,.01,"I")
  1. . S DOSEARR("UNITS",+DOSE)=VADOSE(52.0113,DOSE,2,"I")
  1. . S DOSEARR("NOUN",+DOSE)=VADOSE(52.0113,DOSE,3,"I")
  1. . S DOSEARR("DURATION",+DOSE)=VADOSE(52.0113,DOSE,4,"I")
  1. . I VADOSE(52.0113,DOSE,5,"I")'="" D
  1. . . S DOSEARR("CONJUNCTION",+DOSE)=VADOSE(52.0113,DOSE,5,"I")
  1. . S DOSEARR("ROUTE",+DOSE)=VADOSE(52.0113,DOSE,6,"I")
  1. . S DOSEARR("SCHEDULE",+DOSE)=VADOSE(52.0113,DOSE,7,"I")
  1. . S DOSEARR("VERB",+DOSE)=VADOSE(52.0113,DOSE,8,"I")
  1. Q
  1. ;
  1. 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", ...)
  1. ; ORDIEN - Pointer to PENDING OUTPATIENT ORDERS file (#52.41)
  1. ; PENDATA - Array containing the Pending Order data
  1. ; RENEWORD - Renewal Pending Order? 1: YES | 0/null - NO ; Sets Pending Order Dosage Information
  1. N DOSE,XE,XEI,XV,XVI,LMLINE,DFN,I,WRPDOSE,DISPUNTS,ROUTE,CONJUNCT,PDUE,DUESEQ,COAGENT,REASON,RESULT,ACK,ALLLN,ERXALLS
  1. S DFN=+$$GET1^DIQ(52.41,ORDIEN,1,"I")
  1. ;
  1. D PDUEDATA^PSOERXU9(.PDUE,ERXIEN,1)
  1. S XEI=0,LMLINE=LINE-1
  1. S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)="Prescriber Drug Use Evaluation:"
  1. I '$D(PDUE) D
  1. . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)=" None",HIGHLN(LMLINE,2)=4
  1. E D
  1. . F DUESEQ=1:1 Q:'$D(PDUE(DUESEQ)) D
  1. . . S COAGENT=$P(PDUE(DUESEQ),"^",8)
  1. . . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)="Co-Agent: "_$$COMPARE^PSOERUT0("LM",$E(COAGENT,1,29),$E(COAGENT,1,29),11,,LMLINE)
  1. . . I $L(COAGENT)>29 D
  1. . . . F I=1:1 S COAGENT=$E(COAGENT,30,999) Q:COAGENT="" D
  1. . . . . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)=" "_$$COMPARE^PSOERUT0("LM",$E(COAGENT,1,29),$E(COAGENT,1,29),11,,LMLINE)
  1. . . S REASON=$P(PDUE(DUESEQ),"^",2) I $$PRESOLV^PSOERXA1(REASON,"REA") S REASON=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(REASON,"REA"),.02)
  1. . . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)="Reason: "_$$COMPARE^PSOERUT0("LM",$E(REASON,1,30),$E(REASON,1,30),9,,LMLINE)
  1. . . I $L(REASON)>31 D
  1. . . . F I=1:1 S REASON=$E(REASON,32,999) Q:REASON="" D
  1. . . . . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)=" "_$$COMPARE^PSOERUT0("LM",$E(REASON,1,31),$E(REASON,1,31),9,,LMLINE)
  1. . . S RESULT=$P(PDUE(DUESEQ),"^",4) I $$PRESOLV^PSOERXA1(RESULT,"RES") S RESULT=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(RESULT,"RES"),.02)
  1. . . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)="Result: "_$$COMPARE^PSOERUT0("LM",$E(RESULT,1,31),$E(RESULT,1,31),9,,LMLINE)
  1. . . I $L(RESULT)>31 D
  1. . . . F I=1:1 S RESULT=$E(RESULT,32,999) Q:RESULT="" D
  1. . . . . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)=" "_$$COMPARE^PSOERUT0("LM",$E(RESULT,1,31),$E(RESULT,1,31),8,,LMLINE)
  1. . . S ACK=$P(PDUE(DUESEQ),"^",9)
  1. . . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)="Override: "_$$COMPARE^PSOERUT0("LM",$E(ACK,1,29),$E(ACK,1,29),11,,LMLINE)
  1. . . I $L(ACK)>29 D
  1. . . . F I=1:1 S ACK=$E(ACK,30,999) Q:ACK="" D
  1. . . . . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)=" "_$$COMPARE^PSOERUT0("LM",$E(ACK,1,29),$E(ACK,1,29),11,,LMLINE)
  1. . . I $O(PDUE(DUESEQ)) S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)="......................................"
  1. ;
  1. S XVI=0,LMLINE=LINE-1
  1. I '$D(PENDATA) D Q
  1. . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=$S('RENEWORD:"3) ",1:" ")_" *Dosage:"
  1. F DOSE=1:1 Q:'$D(PENDATA("DOSE",DOSE)) D
  1. . I '$G(PENDATA("DOSE ORDERED",DOSE)),$G(PENDATA("VERB",DOSE))]"" D
  1. . . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" Verb: "_$$COMPARE^PSOERUT0("LM",PENDATA("VERB",DOSE),PENDATA("VERB",DOSE),55,,LMLINE)
  1. . S DOSEX=PENDATA("DOSE",DOSE) I $E(DOSEX,1)=".",$G(PENDATA("DOSE ORDERED",DOSE)) S DOSEX="0"_DOSEX
  1. . I $G(PENDATA("UNITS",DOSE))]"" S DOSEX=DOSEX_" ("_$$GET1^DIQ(50.607,PENDATA("UNITS",DOSE),.01)_")"
  1. . D WRAP^PSOERUT(DOSEX,24,.WRPDOSE)
  1. . 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)
  1. . I DOSE=1,'RENEWORD S UNDERLN(LMLINE,41)=2
  1. . F I=2:1 Q:'$D(WRPDOSE(I)) D
  1. . . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$G(WRPDOSE(I,0)),$G(WRPDOSE(I,0)),55,,LMLINE)
  1. . I $G(PENDATA("DOSE ORDERED",DOSE)),$G(PENDATA("VERB",DOSE))]"" D
  1. . . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" Verb: "_$$COMPARE^PSOERUT0("LM",PENDATA("VERB",DOSE),PENDATA("VERB",DOSE),55,,LMLINE)
  1. . I '$G(PENDATA("DOSE ORDERED",DOSE)),$P($G(^PS(55,DFN,"LAN")),"^") D
  1. . . D WRAP^PSOERUT($G(PENDATA("ODOSE",DOSE)),22,.WRPDOSE)
  1. . . 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)
  1. . . F I=2:1 Q:'$D(WRPDOSE(I)) D
  1. . . . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$G(WRPDOSE(I,0)),$G(WRPDOSE(I,0)),59,,LMLINE)
  1. . I $G(PENDATA("DOSE ORDERED",DOSE))'="" D
  1. . . S DISPUNTS=$S($E(PENDATA("DOSE ORDERED",DOSE),1)=".":"0",1:"")_PENDATA("DOSE ORDERED",DOSE)
  1. . . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" Disp. Units: "_$$COMPARE^PSOERUT0("LM",DISPUNTS,DISPUNTS,55,,LMLINE)
  1. . I $G(PENDATA("NOUN",DOSE))'="" D
  1. . . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" Noun: "_$$COMPARE^PSOERUT0("LM",PENDATA("NOUN",DOSE),PENDATA("NOUN",DOSE),55,,LMLINE)
  1. . I $G(PENDATA("ROUTE",DOSE)) S ROUTE=$$GET1^DIQ(51.2,PENDATA("ROUTE",DOSE),.01)
  1. . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" *Route: "_$$COMPARE^PSOERUT0("LM",$G(ROUTE),$G(ROUTE),55,,LMLINE)
  1. . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" *Schedule: "_$$COMPARE^PSOERUT0("LM",PENDATA("SCHEDULE",DOSE),PENDATA("SCHEDULE",DOSE),55,,LMLINE)
  1. . I $G(PENDATA("DURATION",DOSE))'="" D
  1. . . N DUR S DUR=PENDATA("DURATION",DOSE)
  1. . . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" *Duration: "_$$COMPARE^PSOERUT0("LM",DUR_" "_$$FREQ(DUR),DUR_" "_$$FREQ(DUR),55,,LMLINE)
  1. . I $G(PENDATA("CONJUNCTION",DOSE))'="" D
  1. . . S CONJUNCT=$S(PENDATA("CONJUNCTION",DOSE)="T":"THEN",PENDATA("CONJUNCTION",DOSE)="X":"EXCEPT",1:"AND")
  1. . . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)="*Conjunction: "_$$COMPARE^PSOERUT0("LM",CONJUNCT,CONJUNCT,55,,LMLINE)
  1. ;
  1. ; - Patient Instructions
  1. S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)="________________________________________"
  1. S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=$S('RENEWORD:"4) ",1:"")_"Patient Instruction:"
  1. I 'RENEWORD S UNDERLN(LMLINE,41)=2
  1. S VAPATINS="" F I=1:1 Q:'$D(PENDATA("SIG",I)) S VAPATINS=VAPATINS_" "_$$UP^XLFSTR($G(PENDATA("SIG",I)))
  1. S $E(VAPATINS)=""
  1. I VAPATINS'="" D
  1. . K VARR D WRAP^PSOERUT(VAPATINS,39,.VARR)
  1. . F I=1:1 Q:'$D(VARR(I)) D
  1. . . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$G(VARR(I,0)),$G(VARR(I,0)),42,,LMLINE)
  1. I $O(PENDATA("SINS",0)) D
  1. . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" Other Lang. Pat. Instruct: :"
  1. . S VAOTHINS="" F I=1:1 Q:'$D(PENDATA("SINS",I)) S VAOTHINS=VAOTHINS_" "_$$UP^XLFSTR($G(PENDATA("SINS",I)))
  1. . S $E(VAOTHINS)=""
  1. . K VARR D WRAP^PSOERUT(VAOTHINS,39,.VARR)
  1. . F I=1:1 Q:'$D(VARR(I)) D
  1. . . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$G(VARR(I,0)),$G(VARR(I,0)),42,,LMLINE)
  1. ;
  1. ; - Setting eRx Prescriber Drug Use Evaluation (DUE), Matched Dosage and Patient Instructions
  1. F ALLLN=1:1 Q:('$D(ERXLINES(ALLLN))&'$D(VALINES(ALLLN))) D
  1. . S ERXALLS=$G(ERXLINES(ALLLN)),VAALLS=$G(VALINES(ALLLN))
  1. . S XE=$G(ERXLINES(ALLLN))
  1. . S XV="|"_$G(VALINES(ALLLN))
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
  1. ;
  1. Q
  1. ;
  1. PENFLAG(NMSPC,ORD) ; Backdoor ListManager Display of Flag/Unflag Information
  1. N FLAG,FLAGHDR,XX,FLAGCOMM
  1. ;
  1. D GETS^DIQ(52.41,ORD,"33;34;35;36;37;38","IE","FLAG") I '$G(FLAG(52.41,ORD_",",33,"I")) Q
  1. S XX="Order Flagged by "_FLAG(52.41,ORD_",",34,"E")_" on "_FLAG(52.41,ORD_",",33,"E")
  1. S $E(FLAGHDR,(81-$L(XX))/2)=XX
  1. S UNDERLN(LINE,1)=100
  1. D ADDLINE^PSOERUT0("LM",NMSPC,FLAGHDR,"")
  1. S XX=FLAG(52.41,ORD_",",35,"E")
  1. F Q:XX="" D
  1. . S FLAGCOMM=$E(XX,1,79)
  1. . S FLAGCOMM=" "_$$COMPARE^PSOERUT0("LM",$E(XX,1,79),$E(XX,1,79),2),XX=$E(XX,80,9999)
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,FLAGCOMM,"")
  1. I FLAG(52.41,ORD_",",36,"I")'="" D
  1. . S XX="Order Un-Flagged by "_FLAG(52.41,ORD_",",37,"E")_" on "_FLAG(52.41,ORD_",",36,"E")
  1. . S FLAGHDR="",$E(FLAGHDR,(81-$L(XX))/2)=XX
  1. . S UNDERLN(LINE,1)=100
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,FLAGHDR,"")
  1. . S XX=FLAG(52.41,ORD_",",38,"E")
  1. . F Q:XX="" D
  1. . . S FLAGCOMM=$E(XX,1,79)
  1. . . S FLAGCOMM=" "_$$COMPARE^PSOERUT0("LM",$E(XX,1,79),$E(XX,1,79),2),XX=$E(XX,80,9999)
  1. . . D ADDLINE^PSOERUT0("LM",NMSPC,FLAGCOMM,"")
  1. D BLANKLN^PSOERUT0("LM",1)
  1. Q
  1. ;
  1. ACCDTBY(ERXIEN) ; Returns the eRx latest Accepted Date/Time
  1. ; Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
  1. ;Output: P1^P2 - P1: External Accepted Date/Time (MM/DD/YY) | P2: Accepted By Name
  1. ;
  1. N ACCDTBY,ACDTTM,ACBY,STHIS,FOUND,STAT
  1. S ACCDTBY="",STHIS=99999,FOUND=0
  1. F S STHIS=$O(^PS(52.49,ERXIEN,19,STHIS),-1) Q:'STHIS!(FOUND) D
  1. . S STAT=$$GET1^DIQ(52.4919,STHIS_","_ERXIEN,.02,"I")
  1. . I ",PR,RXP,CXP,"[(","_$$GET1^DIQ(52.45,STAT,.01,"E")_",") D
  1. . . S ACCDTBY=$$FMTE^XLFDT($$GET1^DIQ(52.4919,STHIS_","_ERXIEN,.01,"I"),"2Y")_"^"_$$GET1^DIQ(52.4919,STHIS_","_ERXIEN,.03,"E")
  1. . . S FOUND=1
  1. Q ACCDTBY
  1. ;
  1. PROVCOMM(COMM) ; Expand Provider Comments
  1. ; Input: Provider Comments
  1. ;Output: Expanded Comments
  1. N PROVCOMM,X,PSODIR,INS1
  1. I $G(COMM)="" Q ""
  1. S COMM=$$UP^XLFSTR(COMM)
  1. S (X,PSODIR("INS"))=COMM D SIG^PSOHELP S $E(INS1)="",PROVCOMM=INS1
  1. Q PROVCOMM
  1. ;
  1. FREQ(DUR) ; Returns the Duration Frequency word (WEEKS, DAYS, etc..)
  1. ; Input: DUR - Schedule Duration (e.g., "4D", "3W", "6H", etc...)
  1. ;Output: Spelled out duration frequency between parenthesis ("(DAYS)", "(WEEKS)", "(HOURS)", etc...)
  1. S DUR=$G(DUR)
  1. I DUR["M" Q "(MINUTES)"
  1. I DUR["H" Q "(HOURS)"
  1. I DUR["L" Q "(MONTHS)"
  1. I DUR["W" Q "(WEEKS)"
  1. Q "(DAYS)"