- PSOERXD2 ;ALB/BWF - eRx Drug edit actions ; Jan 06, 2023@08:14:59
- ;;7.0;OUTPATIENT PHARMACY;**467,506,520,508,551,581,617,651,689,700,746**;DEC 1997;Build 106
- SBN ;
- N Y,ERXIEN
- S Y=$P(XQORNOD(0),"=",2)
- ;
- I +Y'=1,'$$GET1^DIQ(52.49,PSOIEN,3.2,"I")!'$D(^PS(52.49,PSOIEN,21)) D S VALMBCK="R" Q
- . S VALMSG="You must update the Dispense Drug first!" W $C(7)
- ;
- I Y']"" S VALMBCK="R" Q
- D EDIT^PSOERX1A("D",Y)
- S VALMBCK="R"
- Q
- VDRG1(PSOIEN,PSOIENS) ;
- N VANDRG,VAODRG,DIE,DA,DR,AUTOVAL,DIC,Y,QTLOOP,SELDRG,VDRG,VANDRG,VAOI,PATINST,FIELD,MTYPE,RESTYPE,ERXSTATA,NEWVAL,ERXMSG,FDA
- Q:'$G(PSOIEN)
- S VAODRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
- S AUTOVAL=$$GET1^DIQ(52.49,PSOIEN,1.4,"I")
- S MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
- S RESTYPE=$$GET1^DIQ(52.49,PSOIEN,52.1,"E")
- S ERXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
- I '$$GET1^DIQ(52.49,PSOIEN,3.2,"I") S XQORM("B")="Edit"
- I VAODRG W !,"Current Vista Drug: "_$$GET1^DIQ(50,VAODRG,.01,"E")_" "_$P($$VADRSCH^PSOERXUT(VAODRG),"^",3)_$S($P(^PSDRUG(VAODRG,0),"^",9):"***(N/F)***",1:"") ;p689
- ; for now allow user to search by drug name. may enhance screening in the future.
- S DIC(0)="AEMQ",DIC=50,DIC("S")="I $$ACTIVE^PSOERXA0(Y),($$OUTPAT^PSOERXA0(Y))"
- I VAODRG]"" S DIC("B")=$$GET1^DIQ(50,+VAODRG,.01,"E")
- S (PQUIT,SELDRG)=0
- F D ^DIC D I PQUIT!SELDRG Q
- . I $G(DUOUT)!($P(Y,U)<1) S PQUIT=1 Q
- . D PRDRVAL^PSOERXUT(.ERXMSG,"ED",PSOIEN,0,$P(Y,U))
- . I 'ERXMSG D I $P(ERXMSG,"^",2)="B" S PQUIT=1 D PAUSE^PSOERXUT Q
- . . W !,"*********************************",$S($P(ERXMSG,"^",2)="W":" WARNING(S) ",1:"INVALID DRUG"),"***********************************"
- . . S I=0 F S I=$O(ERXMSG(I)) Q:'I W !,$P(ERXMSG(I),"^")
- . . W !,"********************************************************************************",$C(7)
- . S SELDRG=Y K DIC
- I PQUIT Q
- W !!,"You have selected: "_$P(Y,U,2)_$S($P(^PSDRUG(+Y,0),"^",9):" ***(N/F)***",1:""),!,"Would you like to use this drug/supply?" S DIR(0)="YO" D ^DIR K DIR ;p689
- I Y="^"!(Y<1) S PQUIT=1 Q
- S DIE="^PS(52.49,",DA=PSOIEN,DR="3.2///"_$P(SELDRG,U,1)
- ; If VistA Drug change, auto-matched before, change DRUG STAT (AUTO-VAL) #1.4 to 2 (VALIDATED/EDITED)
- I +SELDRG'=$$GET1^DIQ(52.49,+PSOIENS,3.2,"I"),$$GET1^DIQ(52.49,+PSOIENS,1.4,"I")=1 S DR=DR_";1.4///2"
- D ^DIE
- ;Saving the eRx Audit Log for the Dispense Drug entered
- S NEWVAL(1)=$$GET1^DIQ(50,+SELDRG,.01)_" (NDC#: "_$$GETNDC^PSSNDCUT(+SELDRG)_")"
- D AUDLOG^PSOERXUT(+PSOIEN,"DRUG",DUZ,.NEWVAL)
- ;
- ; set the manual validation flag if the drug has been selected.
- S VANDRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
- I ERXSTAT="N" D UPDSTAT^PSOERXU1(PSOIEN,"I")
- I MTYPE="RE",ERXSTAT'="RXI" D UPDSTAT^PSOERXU1(PSOIEN,"RXI")
- ; if the drug has changed, update the manual validation by and date/time
- I VANDRG'="",VAODRG'=VANDRG D
- .S QTLOOP=0 F S QTLOOP=$O(^PS(52.49,PSOIEN,21,QTLOOP)) Q:'QTLOOP D
- ..S FDA(52.4921,QTLOOP_","_PSOIENS,.01)="@" D FILE^DIE(,"FDA") K FDA
- .; if the drug is the same, leave the manual validation,otherwise delete it.
- .N FLD F FLD=1.5,1.11,1.12,20.1,20.2,20.3,20.4,20.5,27 S FDA(52.49,PSOIENS,FLD)="@"
- .D FILE^DIE(,"FDA") K FDA
- .I MTYPE="N" D UPDSTAT^PSOERXU1(PSOIEN,"I")
- ; get and file patient instructions
- S VDRG=VANDRG
- S VAOI=$$GET1^DIQ(50,VDRG,2.1,"I")
- S PATINST=$$GET1^DIQ(50.7,VAOI,7,"E")
- I $L(PATINST) D
- .S FDA(52.49,PSOIENS,27)=$G(PATINST)
- .;Saving the eRx Audit Log for Patient Instructions from Orderable Item
- .S NEWVAL(1)=PATINST
- .D AUDLOG^PSOERXUT(+PSOIEN,"PATIENT INSTRUCTIONS",DUZ,.NEWVAL)
- ;
- D FILE^DIE(,"FDA") K FDA
- Q
- VDRG2(PSOIEN,PSOIENS) ;
- N PSOQTS,PSOFROM,PSODOSE,PSONEW,PSODRUG,PSORXED,VERB,QTIEN,SFIENS,DOSE,PSODFN,CURDOSE,NEWDOSE,IENS,ENT,I
- S IENS=1_","_PSOIEN_","
- S PSODFN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
- I 'PSODFN D Q
- .W !,"Cannot continue with dosing instructions until patient has been matched." D DIRE^PSOERXX1
- .S PQUIT=1
- ; drug ien and orderable item ien
- D DERX1(PSOIEN,PSOIENS,1)
- S PSODRUG("IEN")=$$GET1^DIQ(52.49,PSOIEN,3.2,"I") Q:'PSODRUG("IEN")
- S PSODRUG("OI")=$$GET1^DIQ(50,PSODRUG("IEN"),2.1,"I") Q:'PSODRUG("OI")
- ;
- ; Retrieving Existing Dosage
- K PSORXED D ERXDOSE^PSOERUT4(PSOIEN,.PSORXED)
- ;
- S CURDOSE=$$GET1^DIQ(52.4921,IENS,9,"E")
- ; SET PSOFROM=PENDING so the dosage list will activate and present to the user
- S ENT=0,PSOFROM="PENDING"
- COMPLEX ; This line tag is used for Complex Doses (Loop back here from below)
- S ENT=ENT+1,PSORXED("ENT")=ENT
- D DOSE^PSSORPH(.DOSE,PSODRUG("IEN"),"O",PSODFN)
- D ASK^PSOBKDED
- I $G(DOSE)']"" S PQUIT=1 Q
- I $$GET1^DIQ(52.49,PSOIEN,1,"E")="N" D UPDSTAT^PSOERXU1(PSOIEN,"I")
- I $G(VERB)]"" S PSORXED("VERB",ENT)=VERB G DUPD
- VER ;
- D DERX1(PSOIEN,PSOIENS,1)
- ;below logic brought over from VER^PSOOREDX
- D KV S DIR(0)="52.0113,8"
- S:$G(PSORXED("VERB",ENT))]"" DIR("B")=PSORXED("VERB",ENT)
- D ^DIR
- I X[U,$L(X)>1 S FIELD="VER" G JUMP
- G:$D(DTOUT)!($D(DUOUT)) EXQ
- I X="@" K PSORXED("VERB",ENT),VERB G DUPD
- S:X'="" (PSORXED("VERB",ENT),VERB)=X
- DUPD ;
- I $G(PSORXED("DOSE",ENT))'?.N&($G(PSORXED("DOSE",ENT))'?.N1".".N)!'DOSE("LD") K PSORXED("DOSE ORDERED",ENT),DUPD G NOU1
- ; below logic brought over from DUPD^PSOOREDX
- D KV S DIR(0)="52.0113,1",DIR("A")="DISPENSE UNITS PER DOSE"_$S($G(PSORXED("NOUN",ENT))]"":"("_PSORXED("NOUN",ENT)_")",1:"")
- I '$G(PSORXED("DOSE",ENT)),$G(PSORXED("DOSE",ENT-1)) S PSORXED("DOSE",ENT)=PSORXED("DOSE",ENT-1)
- S DIR("B")=$S($G(PSORXED("DOSE ORDERED",ENT))]"":PSORXED("DOSE ORDERED",ENT),1:1) S:$E($G(DIR("B")),1)="." DIR("B")="0"_$G(DIR("B")) K:DIR("B")="" DIR("B")
- D ^DIR I X[U,$L(X)>1 S FIELD="DUPD" G JUMP
- G:$D(DTOUT)!($D(DUOUT)) EXQ
- I X="@"!(X=0) W !,"Dispense Units Per Dose is Required!!",! G DUPD
- ;below logic brought over from STR^PSOOREDX
- S:+STRE>0&(X>0) PSORXED("DOSE",ENT)=(X*STRE) W !,"Dosage Ordered: "_$S($E(PSORXED("DOSE",ENT),1)=".":"0",1:"")_PSORXED("DOSE",ENT)_UNITN,!
- S:X'="" (PSORXED("DOSE ORDERED",ENT),DUPD)=X
- NOU1 ;
- G:'$G(PSORXED("DOSE ORDERED",ENT)) RTE
- D CNON^PSOERXD3
- N PSONDEF
- I $G(NOUN)]"" S PSORXED("NOUN",ENT)=NOUN
- NOU ;
- ;below logic brought over from NOU^PSOOREDX
- D KV S DIR(0)="52.0113,3"
- S DIR("B")=$S($G(NOUN)]"":NOUN,1:$G(PSORXED("NOUN",ENT))) K:DIR("B")="" DIR("B")
- S PSONDEF=$G(DIR("B"))
- D ^DIR
- I X[U,$L(X)>1 S FIELD="NOU" G JUMP
- G:$D(DTOUT)!($D(DUOUT)) EXQ
- I X="@" K PSORXED("NOUN",ENT),NOUN G RTE
- I X'="",$G(PSONDEF)="" S NOUN=X
- I X'="",$G(PSONDEF)'=X S NOUN=X
- S:X'="" PSORXED("NOUN",ENT)=X
- ;
- RTE ;
- N CURTE,ERXRTE
- S CURTE=$$GET1^DIQ(52.4921,ENT_","_PSOIEN_",",10,"E") S PSORXED("ROUTE",ENT)=CURTE
- K JUMP
- S ROU="PSOERXD2" D RTE2^PSOERXD3 K ROU
- K ROU
- I $G(JUMP) K JUMP G JUMP
- G:$D(DTOUT)!($D(DUOUT)) EXQ
- ;
- SCH ;
- K PSOSCH,DIR,CURSCH,NEWSCH
- I '$D(ENT) S ENT=PSORXED("ENT")
- S CURSCH=$$GET1^DIQ(52.4921,ENT_","_PSOIEN_",",1,"E") I CURSCH]"" S DIR("B")=CURSCH
- I $G(DIR("B"))="",$$GET1^DIQ(50.7,+$G(PSODRUG("OI")),.08)'="" S DIR("B")=$$GET1^DIQ(50.7,+$G(PSODRUG("OI")),.08)
- S DIR("?")="^D SCHLP^PSOORED4",DIR("A")="Schedule: ",DIR(0)="FA^1:20^I X[""""""""!(X?.E1C.E)!($A(X)=45)!($L(X,"" "")>$S(X[""PRN"":4,1:3))!($L(X)>20)!($L(X)<1) K X"
- D ^DIR
- I X[U,$L(X)>1 S FIELD="SCH" G JUMP
- G:$D(DTOUT)!($D(DUOUT)) EXQ
- S SCH=$$SCHASL^PSOORED5(Y) D SCH^PSOSIG I $G(SCH)']""!($D(DTOUT))!($D(DUOUT)) G SCH
- S PSORXED("SCHEDULE",ENT)=SCH IF $G(SCHEX)'="" W " ("_SCHEX_")" K SCH,SCHEX,X,Y,PSOSCH
- S:PSORXED("ENT")<ENT PSORXED("ENT")=ENT
- S PSORXED("SCHEDULE",ENT)=$$UP^XLFSTR(PSORXED("SCHEDULE",ENT))
- ;
- DUR D KV K EXP
- S DIR(0)="52.0113,4",DIR("A")="LIMITED DURATION (IN DAYS, HOURS OR MINUTES)"
- S DIR("B")=$S($G(PSORXED("DURATION",ENT))]"":PSORXED("DURATION",ENT),1:"") K:DIR("B")="" DIR("B")
- D ^DIR I X[U,$L(X)>1 S FIELD="DUR" G JUMP
- G:$D(DTOUT)!($D(DUOUT)) EXQ
- D DUR1^PSOOREDX
- ;
- CON D CON^PSOOREDX I X[U,$L(X)>1 S FIELD="CON" G JUMP
- G:$D(DTOUT)!($D(DUOUT)) EXQ
- I X="@",$G(PSORXED("CONJUNCTION",ENT))="" W !,?10,"Invalid Entry - nothing to delete!!" G CON
- S:X'=""&(X'="@") PSORXED("CONJUNCTION",ENT)=Y
- I X="@" D CON1^PSOOREDX G:$D(DIRUT) EXQ G:'Y CON N CKX S CKX=1 D UPD^PSOOREDX G CON
- I '$$DUROK^PSOORED3(.PSORXED,ENT) D G DUR
- . W !!,"Duration is required for the dosage entered prior to the THEN conjunction.",$C(7),!
- I $G(PSORXED("CONJUNCTION",ENT))]"" K DIR G COMPLEX
- ;
- S P01=$S($L($G(PSORXED("DOSE ORDERED",1))):$G(PSORXED("DOSE ORDERED",1))_"&"_$G(PSORXED("NOUN",1)),1:$G(PSORXED("DOSE",1)))
- I '$L(P01) D Q
- . W !,"Dosage is required. Please re-enter the dosing instructions." S DIR(0)="W" D ^DIR D EX Q
- ;
- N SIG,SIGDAT,SLOOP,P01,I,DDONE,EDFLG
- S X=$G(PSORXED("INS")) D SIG^PSOHELP S:$G(INS1)]"" PSORXED("SIG")=$E(INS1,2,9999999)
- D EN^PSOFSIG(.PSORXED)
- ; delete existing SIG
- S SLOOP=0 F S SLOOP=$O(^PS(52.49,PSOIEN,"SIG",SLOOP)) Q:'SLOOP D
- . S FDA(52.4926,SLOOP_","_PSOIEN_",",.01)="@"
- I $D(FDA) D FILE^DIE(,"FDA") K FDA
- ; file sig into VA DISPENSING INSTRUCTIONS multiple
- S SLOOP=0 F S SLOOP=$O(SIG(SLOOP)) Q:'SLOOP D
- . S SIGDAT=$G(SIG(SLOOP)) Q:SIGDAT=""
- . S SFDA(52.4926,"+1,"_PSOIENS,.01)=SIGDAT D UPDATE^DIE(,"SFDA",,"SERR") K SFDA
- ;
- ;Saving the eRx Audit Log for the SIG
- D AUDLOG^PSOERXUT(+PSOIEN,"SIG",DUZ,.SIG)
- ;
- ; Deleting Existing Dosage
- N DIK,DA S DIK="^PS(52.49,"_PSOIEN_",21,",DA(1)=PSOIEN
- S DA=0 F S DA=$O(^PS(52.49,PSOIEN,21,DA)) Q:'DA D ^DIK
- ; Saving Edited Dosage
- K FDA
- F I=1:1:ENT D
- . S FDA(52.4921,"+1,"_PSOIENS,.01)=$S($L($G(PSORXED("DOSE ORDERED",1))):$G(PSORXED("DOSE ORDERED",1))_"&"_$G(PSORXED("NOUN",1)),1:$G(PSORXED("DOSE",1)))
- . S FDA(52.4921,"+1,"_PSOIENS,1)=$G(PSORXED("SCHEDULE",I))
- . S FDA(52.4921,"+1,"_PSOIENS,2)=$G(PSORXED("DURATION",I))
- . S FDA(52.4921,"+1,"_PSOIENS,6)=$S($G(PSORXED("CONJUNCTION",I))="T":"S",1:$G(PSORXED("CONJUNCTION",I)))
- . S FDA(52.4921,"+1,"_PSOIENS,8)=$G(PSORXED("DOSE",I))
- . S FDA(52.4921,"+1,"_PSOIENS,9)=$G(PSORXED("DOSE ORDERED",I))
- . S FDA(52.4921,"+1,"_PSOIENS,10)=$G(PSORXED("ROUTE",I))
- . S FDA(52.4921,"+1,"_PSOIENS,11)=$G(PSORXED("UNITS",I))
- . S FDA(52.4921,"+1,"_PSOIENS,12)=$G(PSORXED("NOUN",I))
- . S FDA(52.4921,"+1,"_PSOIENS,13)=$G(PSORXED("VERB",I))
- . D UPDATE^DIE("","FDA") K FDA
- ;
- N UNEXINS,UNEXARY
- D SETUNEX^PSOERXD3
- ;
- EX ;
- K PSOBDR,PSOBDRG,PSOSCH,DUPD,STRE,UNITN,SCH,VERB,NOUN,DOSEOR,RTE,DUR,X,Y,ENTS,PSODOSE,OLENT,FIELD,FLDNM,AR,NM,ENT,STRE,UNITN,PSODOSE,ERTE,ROU,AR1,INS1
- KV K DTOUT,DUOUT,DIR,DIRUT,DA
- Q
- EXQ ;
- K PSORXED,PSOSIGFL M PSORXED=PSODOSE D EN^PSOFSIG(.PSORXED) D MP1
- I $D(PSOBDR) M PSODRUG=PSOBDR K PSOBDR,PSOBDRG
- S PQUIT=1
- G EX Q
- MP1 ;
- S VALMSG="eRx Not Updated!"
- Q
- JUMP ;jump to fields
- I $L($E(X,2,99))<3 W !,"Field Name Must Be At Least 3 Characters in Length",! G @FIELD
- D FNM^PSOERXD3
- I FLDNM']"" K X,NM,FLDNM W !,"INVALID FIELD NAME. PLEASE TRY AGAIN!",! G @FIELD
- F AR=1:1:PSORXED("ENT") W !,AR_". "_$P(FLDNM,"^",2)_": "_$S(NM="ROU"&($G(PSORXED($P(FLDNM,"^"),AR))):$P(^PS(51.2,PSORXED($P(FLDNM,"^"),AR),0),"^"),1:$G(PSORXED($P(FLDNM,"^"),AR))) S AR1=AR
- D KV S DIR("A")="Select Field to Edit by number",DIR(0)="NO^1:"_AR1 D ^DIR G:$D(DIRUT) @FIELD
- D JFN^PSOERXD3
- I $G(FLDNM)'="",$T(@FLDNM)'="" G @FLDNM
- I $G(FIELD)'="",$T(@FIELD)'="" G @FIELD
- G EX
- Q
- VDRG3(PSOIEN,PSOIENS) ;
- N DIR,Y,X,PATINST,ERXDRUG,VDRG,VAOI,FDA,NEWVAL,DEL,INS1,PSODIR,DA
- D DERX1(PSOIEN,PSOIENS,1)
- S ERXDRUG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
- S PATINST=$$GET1^DIQ(52.49,PSOIEN,27,"E")
- I '$L(PATINST) D
- .S VDRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I") Q:'VDRG
- .S VAOI=$$GET1^DIQ(50,VDRG,2.1,"I") Q:'VAOI
- .S PATINST=$$GET1^DIQ(50.7,VAOI,7,"E")
- D KV S DIR(0)="52.49,27",DIR("A")="VA PATIENT INSTRUCTIONS"
- I $L(PATINST) S DIR("B")=PATINST
- D ^DIR K DIR
- I Y["^" S PQUIT=1 Q
- S (INS1,PSODIR("INS"))="",DEL=0 I X="@" S DEL=1
- I 'DEL D
- . S (X,PSODIR("INS"))=Y D SIG^PSOHELP S $E(INS1)=""
- . I $G(INS1)'="",$$UP^XLFSTR($G(PSODIR("INS")))'=$$UP^XLFSTR(INS1) W !,INS1 H 1
- . I $G(INS1)="",$G(PSODIR("INS"))'="" S INS1=PSODIR("INS")
- I $G(INS1)'=""!DEL D
- . S FDA(52.49,PSOIEN_",",27)=$S(DEL:"@",1:$$UP^XLFSTR($G(INS1))) D FILE^DIE(,"FDA") K FDA
- . ;Saving the eRx Audit Log for Patient Instructions (Manually entered)
- . S NEWVAL(1)=$$UP^XLFSTR($G(INS1)) D AUDLOG^PSOERXUT(+PSOIEN,"PATIENT INSTRUCTIONS",DUZ,.NEWVAL)
- Q
- VDRG4(PSOIEN,PSOIENS) ;
- N DIR,Y,USERCOMM,VPATINST,UFLAG,VAPCOMM,ERXPCOMM,FDA,NEWVAL
- ; POSSIBLE FUTURE IMPLEMENTATION OF ERX DETAILS
- S VPATINST=$$GET1^DIQ(52.49,PSOIEN,27,"E")
- S ERXPCOMM=$$GET1^DIQ(52.49,PSOIEN,8,"E")
- S VAPCOMM=$$GET1^DIQ(52.49,PSOIEN,30,"E")
- D KV S DIR(0)="FO^1:240",DIR("A")="VA PROVIDER COMMENTS"
- I VAPCOMM'=""!(ERXPCOMM'="") S DIR("B")=$$PROVCOMM^PSOERUT4($S($L(VAPCOMM):VAPCOMM,1:ERXPCOMM))
- D ^DIR K DIR
- I Y["^" S PQUIT=1 Q
- S USERCOMM=$$UP^XLFSTR(Y) K Y
- I USERCOMM'=$$PROVCOMM^PSOERUT4(USERCOMM) S USERCOMM=$$PROVCOMM^PSOERUT4(USERCOMM) W !,USERCOMM H 1
- S FDA(52.49,PSOIEN_",",30)=$$UP^XLFSTR(USERCOMM) D FILE^DIE(,"FDA") K FDA
- ;Saving the eRx Audit Log for Provider Comments
- S NEWVAL(1)=USERCOMM D AUDLOG^PSOERXUT(+PSOIEN,"PROVIDER COMMENTS",DUZ,.NEWVAL)
- Q
- VDRG5(PSOIEN,PSOIENS) ;
- N PATIEN,PS55IEN,Y,DIE,DR,DA,FDA,ANS,PATSTAT,DONE
- S PATIEN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
- I 'PATIEN W !!,"Patient has not been validated, cannot edit patient status",! Q
- S PSODFN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
- S PATSTAT=$$GET1^DIQ(55,PSODFN,3,"E")
- D KV S DIR("B")=PATSTAT
- S DIR(0)="55,3",DIR("A")="PATIENT STATUS"
- D ^DIR K DIR
- I 'PATSTAT,'+Y D
- .S DONE=0
- .F D Q:DONE
- ..W !,"This is a required response. Enter '^' to exit"
- ..S DIR(0)="55,3",DIR("A")="PATIENT STATUS" D ^DIR K DIR
- ..I +Y S DONE=1 Q
- ..I Y["^" S PQUIT=1,DONE=1 Q
- S ANS=$P(Y,"^",1)
- S FDA(55,PSODFN_",",3)=ANS
- D FILE^DIE(,"FDA","ERR") K FDA,ERR
- Q
- ;PSO*7.0*551 - BEGIN CHANGE - SWITCHING THE ORDER OF VDRG6 AND VDRG7. QUANTITY PROMPT WILL NOW COME BEFORE DAY SUPPLY.
- VDRG6(PSOIEN,PSOIENS) ;
- N DIR,PSODRG,DRGMSG,ERXQTY,VAQTY,DIE,DA,DR,ERXQTYUM
- S PSODRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
- I PSODRG S DRGMSG=$$GET1^DIQ(50,PSODRG,215,"E")
- S ERXQTY=$$GET1^DIQ(52.49,PSOIEN,5.1,"E")
- S ERXQTYUM=$$GET1^DIQ(52.49,PSOIEN,42,"E")
- W !,"eRx Quantity: "_ERXQTY_$S(ERXQTYUM'="":" ("_ERXQTYUM_")",1:"")
- S VAQTY=$$GET1^DIQ(52.49,PSOIEN,20.1,"E")
- S PQUIT=$$QTYDSRFL^PSOERXU4(PSOIEN,2)
- Q
- VDRG7(PSOIEN,PSOIENS) ;
- N Y,ERXDS,DIE,DR,DA
- ; dont prompt for days supply if we are editing 'all' fields or quantity (since quantity prompts for days supply)
- S ERXDS=$$GET1^DIQ(52.49,PSOIEN,5.5,"E")
- W !,"eRx Days Supply: "_ERXDS
- S PQUIT=$$QTYDSRFL^PSOERXU4(PSOIEN,1)
- Q
- VDRG8(PSOIEN,PSOIENS) ;
- N Y,ERXRFLS,DIE,DR,DA
- S ERXRFLS=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
- I $$GET1^DIQ(52.49,PSOIEN,.08,"I")="RE",$$GET1^DIQ(52.49,PSOIEN,52.1,"I")="R" S ERXRFLS=ERXRFLS-1 I ERXRFLS<1 S ERXRFLS=0
- W !,"eRx Refills: "_ERXRFLS
- S PQUIT=$$QTYDSRFL^PSOERXU4(PSOIEN,3)
- Q
- VDRG9(PSOIEN,PSOIENS) ;
- N Y,DIR,DIE,DR,DA
- S DIR("A")="PICKUP ROUTING"
- S DIR(0)="SO^M:MAIL;W:WINDOW"
- I $$GET1^DIQ(52.49,PSOIEN,20.4,"I")'="" S DIR("B")=$$GET1^DIQ(52.49,PSOIEN,20.4,"I")
- E S DIR("B")="M"
- D ^DIR K DIR
- I Y["^" S PQUIT=1 Q
- S DIE="^PS(52.49,",DA=PSOIEN,DR="20.4///"_Y D ^DIE K DIE,DR,DA
- Q
- VDRG10(PSOIEN,PSOIENS) ;
- N DIC,Y,VACLIN,CURCLIN,DIE,DR,DA
- S CURCLIN=$$GET1^DIQ(52.49,PSOIEN,20.6,"E")
- I $$GET1^DIQ(59.7,1,102,"I")="MBM",'CURCLIN,$G(PSOCLNC) S CURCLIN=$$GET1^DIQ(44,PSOCLNC,.01)
- I '$L(CURCLIN) S CURCLIN=$$GET1^DIQ(59,PSOSITE,10,"E")
- S DIC("B")=CURCLIN
- S DIC="^SC(",DIC(0)="QEAMZ",DIC("A")="Select CLINIC: "
- I $$GET1^DIQ(59.7,1,102,"I")="MBM" S DIC("S")="I '$P($G(^(""I"")),U,1)!$P($G(^(""I"")),U,2)"
- D ^DIC K DIC I Y<1 Q
- I ($D(DTOUT))!($D(DUOUT)) S PQUIT=1 Q
- S VACLIN=$P(Y,U)
- S DIE="^PS(52.49,",DA=PSOIEN,DR="20.6////"_VACLIN D ^DIE K DIE,DR,DA
- K DTOUT,DUOUT
- Q
- VDRG11(PSOIEN,PSOIENS) ;
- N DIE,DR,DA,Y
- S DIE="^PS(52.49,",DA=PSOIEN,DR="8" D ^DIE K DIE,DR,DA
- I $O(Y(0)) S PQUIT=1
- Q
- ; display erx info
- ; DFLG - display flag
- ; 1 - drug sig comments
- ; ""- all
- DERX1(PSOIEN,PSOIENS,DFLG) ;
- D DSPERX^PSOERUT(PSOIEN) W !
- ;D DERX1^PSOERXU4(PSOIEN,PSOIENS,$G(DFLG))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXD2 16131 printed Feb 18, 2025@23:54:55 Page 2
- PSOERXD2 ;ALB/BWF - eRx Drug edit actions ; Jan 06, 2023@08:14:59
- +1 ;;7.0;OUTPATIENT PHARMACY;**467,506,520,508,551,581,617,651,689,700,746**;DEC 1997;Build 106
- SBN ;
- +1 NEW Y,ERXIEN
- +2 SET Y=$PIECE(XQORNOD(0),"=",2)
- +3 ;
- +4 IF +Y'=1
- IF '$$GET1^DIQ(52.49,PSOIEN,3.2,"I")!'$DATA(^PS(52.49,PSOIEN,21))
- Begin DoDot:1
- +5 SET VALMSG="You must update the Dispense Drug first!"
- WRITE $CHAR(7)
- End DoDot:1
- SET VALMBCK="R"
- QUIT
- +6 ;
- +7 IF Y']""
- SET VALMBCK="R"
- QUIT
- +8 DO EDIT^PSOERX1A("D",Y)
- +9 SET VALMBCK="R"
- +10 QUIT
- VDRG1(PSOIEN,PSOIENS) ;
- +1 NEW VANDRG,VAODRG,DIE,DA,DR,AUTOVAL,DIC,Y,QTLOOP,SELDRG,VDRG,VANDRG,VAOI,PATINST,FIELD,MTYPE,RESTYPE,ERXSTATA,NEWVAL,ERXMSG,FDA
- +2 if '$GET(PSOIEN)
- QUIT
- +3 SET VAODRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
- +4 SET AUTOVAL=$$GET1^DIQ(52.49,PSOIEN,1.4,"I")
- +5 SET MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
- +6 SET RESTYPE=$$GET1^DIQ(52.49,PSOIEN,52.1,"E")
- +7 SET ERXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
- +8 IF '$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
- SET XQORM("B")="Edit"
- +9 ;p689
- IF VAODRG
- WRITE !,"Current Vista Drug: "_$$GET1^DIQ(50,VAODRG,.01,"E")_" "_$PIECE($$VADRSCH^PSOERXUT(VAODRG),"^",3)_$SELECT($PIECE(^PSDRUG(VAODRG,0),"^",9):"***(N/F)***",1:"")
- +10 ; for now allow user to search by drug name. may enhance screening in the future.
- +11 SET DIC(0)="AEMQ"
- SET DIC=50
- SET DIC("S")="I $$ACTIVE^PSOERXA0(Y),($$OUTPAT^PSOERXA0(Y))"
- +12 IF VAODRG]""
- SET DIC("B")=$$GET1^DIQ(50,+VAODRG,.01,"E")
- +13 SET (PQUIT,SELDRG)=0
- +14 FOR
- DO ^DIC
- Begin DoDot:1
- +15 IF $GET(DUOUT)!($PIECE(Y,U)<1)
- SET PQUIT=1
- QUIT
- +16 DO PRDRVAL^PSOERXUT(.ERXMSG,"ED",PSOIEN,0,$PIECE(Y,U))
- +17 IF 'ERXMSG
- Begin DoDot:2
- +18 WRITE !,"*********************************",$SELECT($PIECE(ERXMSG,"^",2)="W":" WARNING(S) ",1:"INVALID DRUG"),"***********************************"
- +19 SET I=0
- FOR
- SET I=$ORDER(ERXMSG(I))
- if 'I
- QUIT
- WRITE !,$PIECE(ERXMSG(I),"^")
- +20 WRITE !,"********************************************************************************",$CHAR(7)
- End DoDot:2
- IF $PIECE(ERXMSG,"^",2)="B"
- SET PQUIT=1
- DO PAUSE^PSOERXUT
- QUIT
- +21 SET SELDRG=Y
- KILL DIC
- End DoDot:1
- IF PQUIT!SELDRG
- QUIT
- +22 IF PQUIT
- QUIT
- +23 ;p689
- WRITE !!,"You have selected: "_$PIECE(Y,U,2)_$SELECT($PIECE(^PSDRUG(+Y,0),"^",9):" ***(N/F)***",1:""),!,"Would you like to use this drug/supply?"
- SET DIR(0)="YO"
- DO ^DIR
- KILL DIR
- +24 IF Y="^"!(Y<1)
- SET PQUIT=1
- QUIT
- +25 SET DIE="^PS(52.49,"
- SET DA=PSOIEN
- SET DR="3.2///"_$PIECE(SELDRG,U,1)
- +26 ; If VistA Drug change, auto-matched before, change DRUG STAT (AUTO-VAL) #1.4 to 2 (VALIDATED/EDITED)
- +27 IF +SELDRG'=$$GET1^DIQ(52.49,+PSOIENS,3.2,"I")
- IF $$GET1^DIQ(52.49,+PSOIENS,1.4,"I")=1
- SET DR=DR_";1.4///2"
- +28 DO ^DIE
- +29 ;Saving the eRx Audit Log for the Dispense Drug entered
- +30 SET NEWVAL(1)=$$GET1^DIQ(50,+SELDRG,.01)_" (NDC#: "_$$GETNDC^PSSNDCUT(+SELDRG)_")"
- +31 DO AUDLOG^PSOERXUT(+PSOIEN,"DRUG",DUZ,.NEWVAL)
- +32 ;
- +33 ; set the manual validation flag if the drug has been selected.
- +34 SET VANDRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
- +35 IF ERXSTAT="N"
- DO UPDSTAT^PSOERXU1(PSOIEN,"I")
- +36 IF MTYPE="RE"
- IF ERXSTAT'="RXI"
- DO UPDSTAT^PSOERXU1(PSOIEN,"RXI")
- +37 ; if the drug has changed, update the manual validation by and date/time
- +38 IF VANDRG'=""
- IF VAODRG'=VANDRG
- Begin DoDot:1
- +39 SET QTLOOP=0
- FOR
- SET QTLOOP=$ORDER(^PS(52.49,PSOIEN,21,QTLOOP))
- if 'QTLOOP
- QUIT
- Begin DoDot:2
- +40 SET FDA(52.4921,QTLOOP_","_PSOIENS,.01)="@"
- DO FILE^DIE(,"FDA")
- KILL FDA
- End DoDot:2
- +41 ; if the drug is the same, leave the manual validation,otherwise delete it.
- +42 NEW FLD
- FOR FLD=1.5,1.11,1.12,20.1,20.2,20.3,20.4,20.5,27
- SET FDA(52.49,PSOIENS,FLD)="@"
- +43 DO FILE^DIE(,"FDA")
- KILL FDA
- +44 IF MTYPE="N"
- DO UPDSTAT^PSOERXU1(PSOIEN,"I")
- End DoDot:1
- +45 ; get and file patient instructions
- +46 SET VDRG=VANDRG
- +47 SET VAOI=$$GET1^DIQ(50,VDRG,2.1,"I")
- +48 SET PATINST=$$GET1^DIQ(50.7,VAOI,7,"E")
- +49 IF $LENGTH(PATINST)
- Begin DoDot:1
- +50 SET FDA(52.49,PSOIENS,27)=$GET(PATINST)
- +51 ;Saving the eRx Audit Log for Patient Instructions from Orderable Item
- +52 SET NEWVAL(1)=PATINST
- +53 DO AUDLOG^PSOERXUT(+PSOIEN,"PATIENT INSTRUCTIONS",DUZ,.NEWVAL)
- End DoDot:1
- +54 ;
- +55 DO FILE^DIE(,"FDA")
- KILL FDA
- +56 QUIT
- VDRG2(PSOIEN,PSOIENS) ;
- +1 NEW PSOQTS,PSOFROM,PSODOSE,PSONEW,PSODRUG,PSORXED,VERB,QTIEN,SFIENS,DOSE,PSODFN,CURDOSE,NEWDOSE,IENS,ENT,I
- +2 SET IENS=1_","_PSOIEN_","
- +3 SET PSODFN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
- +4 IF 'PSODFN
- Begin DoDot:1
- +5 WRITE !,"Cannot continue with dosing instructions until patient has been matched."
- DO DIRE^PSOERXX1
- +6 SET PQUIT=1
- End DoDot:1
- QUIT
- +7 ; drug ien and orderable item ien
- +8 DO DERX1(PSOIEN,PSOIENS,1)
- +9 SET PSODRUG("IEN")=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
- if 'PSODRUG("IEN")
- QUIT
- +10 SET PSODRUG("OI")=$$GET1^DIQ(50,PSODRUG("IEN"),2.1,"I")
- if 'PSODRUG("OI")
- QUIT
- +11 ;
- +12 ; Retrieving Existing Dosage
- +13 KILL PSORXED
- DO ERXDOSE^PSOERUT4(PSOIEN,.PSORXED)
- +14 ;
- +15 SET CURDOSE=$$GET1^DIQ(52.4921,IENS,9,"E")
- +16 ; SET PSOFROM=PENDING so the dosage list will activate and present to the user
- +17 SET ENT=0
- SET PSOFROM="PENDING"
- COMPLEX ; This line tag is used for Complex Doses (Loop back here from below)
- +1 SET ENT=ENT+1
- SET PSORXED("ENT")=ENT
- +2 DO DOSE^PSSORPH(.DOSE,PSODRUG("IEN"),"O",PSODFN)
- +3 DO ASK^PSOBKDED
- +4 IF $GET(DOSE)']""
- SET PQUIT=1
- QUIT
- +5 IF $$GET1^DIQ(52.49,PSOIEN,1,"E")="N"
- DO UPDSTAT^PSOERXU1(PSOIEN,"I")
- +6 IF $GET(VERB)]""
- SET PSORXED("VERB",ENT)=VERB
- GOTO DUPD
- VER ;
- +1 DO DERX1(PSOIEN,PSOIENS,1)
- +2 ;below logic brought over from VER^PSOOREDX
- +3 DO KV
- SET DIR(0)="52.0113,8"
- +4 if $GET(PSORXED("VERB",ENT))]""
- SET DIR("B")=PSORXED("VERB",ENT)
- +5 DO ^DIR
- +6 IF X[U
- IF $LENGTH(X)>1
- SET FIELD="VER"
- GOTO JUMP
- +7 if $DATA(DTOUT)!($DATA(DUOUT))
- GOTO EXQ
- +8 IF X="@"
- KILL PSORXED("VERB",ENT),VERB
- GOTO DUPD
- +9 if X'=""
- SET (PSORXED("VERB",ENT),VERB)=X
- DUPD ;
- +1 IF $GET(PSORXED("DOSE",ENT))'?.N&($GET(PSORXED("DOSE",ENT))'?.N1".".N)!'DOSE("LD")
- KILL PSORXED("DOSE ORDERED",ENT),DUPD
- GOTO NOU1
- +2 ; below logic brought over from DUPD^PSOOREDX
- +3 DO KV
- SET DIR(0)="52.0113,1"
- SET DIR("A")="DISPENSE UNITS PER DOSE"_$SELECT($GET(PSORXED("NOUN",ENT))]"":"("_PSORXED("NOUN",ENT)_")",1:"")
- +4 IF '$GET(PSORXED("DOSE",ENT))
- IF $GET(PSORXED("DOSE",ENT-1))
- SET PSORXED("DOSE",ENT)=PSORXED("DOSE",ENT-1)
- +5 SET DIR("B")=$SELECT($GET(PSORXED("DOSE ORDERED",ENT))]"":PSORXED("DOSE ORDERED",ENT),1:1)
- if $EXTRACT($GET(DIR("B")),1)="."
- SET DIR("B")="0"_$GET(DIR("B"))
- if DIR("B")=""
- KILL DIR("B")
- +6 DO ^DIR
- IF X[U
- IF $LENGTH(X)>1
- SET FIELD="DUPD"
- GOTO JUMP
- +7 if $DATA(DTOUT)!($DATA(DUOUT))
- GOTO EXQ
- +8 IF X="@"!(X=0)
- WRITE !,"Dispense Units Per Dose is Required!!",!
- GOTO DUPD
- +9 ;below logic brought over from STR^PSOOREDX
- +10 if +STRE>0&(X>0)
- SET PSORXED("DOSE",ENT)=(X*STRE)
- WRITE !,"Dosage Ordered: "_$SELECT($EXTRACT(PSORXED("DOSE",ENT),1)=".":"0",1:"")_PSORXED("DOSE",ENT)_UNITN,!
- +11 if X'=""
- SET (PSORXED("DOSE ORDERED",ENT),DUPD)=X
- NOU1 ;
- +1 if '$GET(PSORXED("DOSE ORDERED",ENT))
- GOTO RTE
- +2 DO CNON^PSOERXD3
- +3 NEW PSONDEF
- +4 IF $GET(NOUN)]""
- SET PSORXED("NOUN",ENT)=NOUN
- NOU ;
- +1 ;below logic brought over from NOU^PSOOREDX
- +2 DO KV
- SET DIR(0)="52.0113,3"
- +3 SET DIR("B")=$SELECT($GET(NOUN)]"":NOUN,1:$GET(PSORXED("NOUN",ENT)))
- if DIR("B")=""
- KILL DIR("B")
- +4 SET PSONDEF=$GET(DIR("B"))
- +5 DO ^DIR
- +6 IF X[U
- IF $LENGTH(X)>1
- SET FIELD="NOU"
- GOTO JUMP
- +7 if $DATA(DTOUT)!($DATA(DUOUT))
- GOTO EXQ
- +8 IF X="@"
- KILL PSORXED("NOUN",ENT),NOUN
- GOTO RTE
- +9 IF X'=""
- IF $GET(PSONDEF)=""
- SET NOUN=X
- +10 IF X'=""
- IF $GET(PSONDEF)'=X
- SET NOUN=X
- +11 if X'=""
- SET PSORXED("NOUN",ENT)=X
- +12 ;
- RTE ;
- +1 NEW CURTE,ERXRTE
- +2 SET CURTE=$$GET1^DIQ(52.4921,ENT_","_PSOIEN_",",10,"E")
- SET PSORXED("ROUTE",ENT)=CURTE
- +3 KILL JUMP
- +4 SET ROU="PSOERXD2"
- DO RTE2^PSOERXD3
- KILL ROU
- +5 KILL ROU
- +6 IF $GET(JUMP)
- KILL JUMP
- GOTO JUMP
- +7 if $DATA(DTOUT)!($DATA(DUOUT))
- GOTO EXQ
- +8 ;
- SCH ;
- +1 KILL PSOSCH,DIR,CURSCH,NEWSCH
- +2 IF '$DATA(ENT)
- SET ENT=PSORXED("ENT")
- +3 SET CURSCH=$$GET1^DIQ(52.4921,ENT_","_PSOIEN_",",1,"E")
- IF CURSCH]""
- SET DIR("B")=CURSCH
- +4 IF $GET(DIR("B"))=""
- IF $$GET1^DIQ(50.7,+$GET(PSODRUG("OI")),.08)'=""
- SET DIR("B")=$$GET1^DIQ(50.7,+$GET(PSODRUG("OI")),.08)
- +5 SET DIR("?")="^D SCHLP^PSOORED4"
- SET DIR("A")="Schedule: "
- SET DIR(0)="FA^1:20^I X[""""""""!(X?.E1C.E)!($A(X)=45)!($L(X,"" "")>$S(X[""PRN"":4,1:3))!($L(X)>20)!($L(X)<1) K X"
- +6 DO ^DIR
- +7 IF X[U
- IF $LENGTH(X)>1
- SET FIELD="SCH"
- GOTO JUMP
- +8 if $DATA(DTOUT)!($DATA(DUOUT))
- GOTO EXQ
- +9 SET SCH=$$SCHASL^PSOORED5(Y)
- DO SCH^PSOSIG
- IF $GET(SCH)']""!($DATA(DTOUT))!($DATA(DUOUT))
- GOTO SCH
- +10 SET PSORXED("SCHEDULE",ENT)=SCH
- IF $GET(SCHEX)'=""
- WRITE " ("_SCHEX_")"
- KILL SCH,SCHEX,X,Y,PSOSCH
- +11 if PSORXED("ENT")<ENT
- SET PSORXED("ENT")=ENT
- +12 SET PSORXED("SCHEDULE",ENT)=$$UP^XLFSTR(PSORXED("SCHEDULE",ENT))
- +13 ;
- DUR DO KV
- KILL EXP
- +1 SET DIR(0)="52.0113,4"
- SET DIR("A")="LIMITED DURATION (IN DAYS, HOURS OR MINUTES)"
- +2 SET DIR("B")=$SELECT($GET(PSORXED("DURATION",ENT))]"":PSORXED("DURATION",ENT),1:"")
- if DIR("B")=""
- KILL DIR("B")
- +3 DO ^DIR
- IF X[U
- IF $LENGTH(X)>1
- SET FIELD="DUR"
- GOTO JUMP
- +4 if $DATA(DTOUT)!($DATA(DUOUT))
- GOTO EXQ
- +5 DO DUR1^PSOOREDX
- +6 ;
- CON DO CON^PSOOREDX
- IF X[U
- IF $LENGTH(X)>1
- SET FIELD="CON"
- GOTO JUMP
- +1 if $DATA(DTOUT)!($DATA(DUOUT))
- GOTO EXQ
- +2 IF X="@"
- IF $GET(PSORXED("CONJUNCTION",ENT))=""
- WRITE !,?10,"Invalid Entry - nothing to delete!!"
- GOTO CON
- +3 if X'=""&(X'="@")
- SET PSORXED("CONJUNCTION",ENT)=Y
- +4 IF X="@"
- DO CON1^PSOOREDX
- if $DATA(DIRUT)
- GOTO EXQ
- if 'Y
- GOTO CON
- NEW CKX
- SET CKX=1
- DO UPD^PSOOREDX
- GOTO CON
- +5 IF '$$DUROK^PSOORED3(.PSORXED,ENT)
- Begin DoDot:1
- +6 WRITE !!,"Duration is required for the dosage entered prior to the THEN conjunction.",$CHAR(7),!
- End DoDot:1
- GOTO DUR
- +7 IF $GET(PSORXED("CONJUNCTION",ENT))]""
- KILL DIR
- GOTO COMPLEX
- +8 ;
- +9 SET P01=$SELECT($LENGTH($GET(PSORXED("DOSE ORDERED",1))):$GET(PSORXED("DOSE ORDERED",1))_"&"_$GET(PSORXED("NOUN",1)),1:$GET(PSORXED("DOSE",1)))
- +10 IF '$LENGTH(P01)
- Begin DoDot:1
- +11 WRITE !,"Dosage is required. Please re-enter the dosing instructions."
- SET DIR(0)="W"
- DO ^DIR
- DO EX
- QUIT
- End DoDot:1
- QUIT
- +12 ;
- +13 NEW SIG,SIGDAT,SLOOP,P01,I,DDONE,EDFLG
- +14 SET X=$GET(PSORXED("INS"))
- DO SIG^PSOHELP
- if $GET(INS1)]""
- SET PSORXED("SIG")=$EXTRACT(INS1,2,9999999)
- +15 DO EN^PSOFSIG(.PSORXED)
- +16 ; delete existing SIG
- +17 SET SLOOP=0
- FOR
- SET SLOOP=$ORDER(^PS(52.49,PSOIEN,"SIG",SLOOP))
- if 'SLOOP
- QUIT
- Begin DoDot:1
- +18 SET FDA(52.4926,SLOOP_","_PSOIEN_",",.01)="@"
- End DoDot:1
- +19 IF $DATA(FDA)
- DO FILE^DIE(,"FDA")
- KILL FDA
- +20 ; file sig into VA DISPENSING INSTRUCTIONS multiple
- +21 SET SLOOP=0
- FOR
- SET SLOOP=$ORDER(SIG(SLOOP))
- if 'SLOOP
- QUIT
- Begin DoDot:1
- +22 SET SIGDAT=$GET(SIG(SLOOP))
- if SIGDAT=""
- QUIT
- +23 SET SFDA(52.4926,"+1,"_PSOIENS,.01)=SIGDAT
- DO UPDATE^DIE(,"SFDA",,"SERR")
- KILL SFDA
- End DoDot:1
- +24 ;
- +25 ;Saving the eRx Audit Log for the SIG
- +26 DO AUDLOG^PSOERXUT(+PSOIEN,"SIG",DUZ,.SIG)
- +27 ;
- +28 ; Deleting Existing Dosage
- +29 NEW DIK,DA
- SET DIK="^PS(52.49,"_PSOIEN_",21,"
- SET DA(1)=PSOIEN
- +30 SET DA=0
- FOR
- SET DA=$ORDER(^PS(52.49,PSOIEN,21,DA))
- if 'DA
- QUIT
- DO ^DIK
- +31 ; Saving Edited Dosage
- +32 KILL FDA
- +33 FOR I=1:1:ENT
- Begin DoDot:1
- +34 SET FDA(52.4921,"+1,"_PSOIENS,.01)=$SELECT($LENGTH($GET(PSORXED("DOSE ORDERED",1))):$GET(PSORXED("DOSE ORDERED",1))_"&"_$GET(PSORXED("NOUN",1)),1:$GET(PSORXED("DOSE",1)))
- +35 SET FDA(52.4921,"+1,"_PSOIENS,1)=$GET(PSORXED("SCHEDULE",I))
- +36 SET FDA(52.4921,"+1,"_PSOIENS,2)=$GET(PSORXED("DURATION",I))
- +37 SET FDA(52.4921,"+1,"_PSOIENS,6)=$SELECT($GET(PSORXED("CONJUNCTION",I))="T":"S",1:$GET(PSORXED("CONJUNCTION",I)))
- +38 SET FDA(52.4921,"+1,"_PSOIENS,8)=$GET(PSORXED("DOSE",I))
- +39 SET FDA(52.4921,"+1,"_PSOIENS,9)=$GET(PSORXED("DOSE ORDERED",I))
- +40 SET FDA(52.4921,"+1,"_PSOIENS,10)=$GET(PSORXED("ROUTE",I))
- +41 SET FDA(52.4921,"+1,"_PSOIENS,11)=$GET(PSORXED("UNITS",I))
- +42 SET FDA(52.4921,"+1,"_PSOIENS,12)=$GET(PSORXED("NOUN",I))
- +43 SET FDA(52.4921,"+1,"_PSOIENS,13)=$GET(PSORXED("VERB",I))
- +44 DO UPDATE^DIE("","FDA")
- KILL FDA
- End DoDot:1
- +45 ;
- +46 NEW UNEXINS,UNEXARY
- +47 DO SETUNEX^PSOERXD3
- +48 ;
- EX ;
- +1 KILL PSOBDR,PSOBDRG,PSOSCH,DUPD,STRE,UNITN,SCH,VERB,NOUN,DOSEOR,RTE,DUR,X,Y,ENTS,PSODOSE,OLENT,FIELD,FLDNM,AR,NM,ENT,STRE,UNITN,PSODOSE,ERTE,ROU,AR1,INS1
- KV KILL DTOUT,DUOUT,DIR,DIRUT,DA
- +1 QUIT
- EXQ ;
- +1 KILL PSORXED,PSOSIGFL
- MERGE PSORXED=PSODOSE
- DO EN^PSOFSIG(.PSORXED)
- DO MP1
- +2 IF $DATA(PSOBDR)
- MERGE PSODRUG=PSOBDR
- KILL PSOBDR,PSOBDRG
- +3 SET PQUIT=1
- +4 GOTO EX
- QUIT
- MP1 ;
- +1 SET VALMSG="eRx Not Updated!"
- +2 QUIT
- JUMP ;jump to fields
- +1 IF $LENGTH($EXTRACT(X,2,99))<3
- WRITE !,"Field Name Must Be At Least 3 Characters in Length",!
- GOTO @FIELD
- +2 DO FNM^PSOERXD3
- +3 IF FLDNM']""
- KILL X,NM,FLDNM
- WRITE !,"INVALID FIELD NAME. PLEASE TRY AGAIN!",!
- GOTO @FIELD
- +4 FOR AR=1:1:PSORXED("ENT")
- WRITE !,AR_". "_$PIECE(FLDNM,"^",2)_": "_$SELECT(NM="ROU"&($GET(PSORXED($PIECE(FLDNM,"^"),AR))):$PIECE(^PS(51.2,PSORXED($PIECE(FLDNM,"^"),AR),0),"^"),1:$GET(PSORXED($PIECE(FLDNM,"^"),AR)))
- SET AR1=AR
- +5 DO KV
- SET DIR("A")="Select Field to Edit by number"
- SET DIR(0)="NO^1:"_AR1
- DO ^DIR
- if $DATA(DIRUT)
- GOTO @FIELD
- +6 DO JFN^PSOERXD3
- +7 IF $GET(FLDNM)'=""
- IF $TEXT(@FLDNM)'=""
- GOTO @FLDNM
- +8 IF $GET(FIELD)'=""
- IF $TEXT(@FIELD)'=""
- GOTO @FIELD
- +9 GOTO EX
- +10 QUIT
- VDRG3(PSOIEN,PSOIENS) ;
- +1 NEW DIR,Y,X,PATINST,ERXDRUG,VDRG,VAOI,FDA,NEWVAL,DEL,INS1,PSODIR,DA
- +2 DO DERX1(PSOIEN,PSOIENS,1)
- +3 SET ERXDRUG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
- +4 SET PATINST=$$GET1^DIQ(52.49,PSOIEN,27,"E")
- +5 IF '$LENGTH(PATINST)
- Begin DoDot:1
- +6 SET VDRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
- if 'VDRG
- QUIT
- +7 SET VAOI=$$GET1^DIQ(50,VDRG,2.1,"I")
- if 'VAOI
- QUIT
- +8 SET PATINST=$$GET1^DIQ(50.7,VAOI,7,"E")
- End DoDot:1
- +9 DO KV
- SET DIR(0)="52.49,27"
- SET DIR("A")="VA PATIENT INSTRUCTIONS"
- +10 IF $LENGTH(PATINST)
- SET DIR("B")=PATINST
- +11 DO ^DIR
- KILL DIR
- +12 IF Y["^"
- SET PQUIT=1
- QUIT
- +13 SET (INS1,PSODIR("INS"))=""
- SET DEL=0
- IF X="@"
- SET DEL=1
- +14 IF 'DEL
- Begin DoDot:1
- +15 SET (X,PSODIR("INS"))=Y
- DO SIG^PSOHELP
- SET $EXTRACT(INS1)=""
- +16 IF $GET(INS1)'=""
- IF $$UP^XLFSTR($GET(PSODIR("INS")))'=$$UP^XLFSTR(INS1)
- WRITE !,INS1
- HANG 1
- +17 IF $GET(INS1)=""
- IF $GET(PSODIR("INS"))'=""
- SET INS1=PSODIR("INS")
- End DoDot:1
- +18 IF $GET(INS1)'=""!DEL
- Begin DoDot:1
- +19 SET FDA(52.49,PSOIEN_",",27)=$SELECT(DEL:"@",1:$$UP^XLFSTR($GET(INS1)))
- DO FILE^DIE(,"FDA")
- KILL FDA
- +20 ;Saving the eRx Audit Log for Patient Instructions (Manually entered)
- +21 SET NEWVAL(1)=$$UP^XLFSTR($GET(INS1))
- DO AUDLOG^PSOERXUT(+PSOIEN,"PATIENT INSTRUCTIONS",DUZ,.NEWVAL)
- End DoDot:1
- +22 QUIT
- VDRG4(PSOIEN,PSOIENS) ;
- +1 NEW DIR,Y,USERCOMM,VPATINST,UFLAG,VAPCOMM,ERXPCOMM,FDA,NEWVAL
- +2 ; POSSIBLE FUTURE IMPLEMENTATION OF ERX DETAILS
- +3 SET VPATINST=$$GET1^DIQ(52.49,PSOIEN,27,"E")
- +4 SET ERXPCOMM=$$GET1^DIQ(52.49,PSOIEN,8,"E")
- +5 SET VAPCOMM=$$GET1^DIQ(52.49,PSOIEN,30,"E")
- +6 DO KV
- SET DIR(0)="FO^1:240"
- SET DIR("A")="VA PROVIDER COMMENTS"
- +7 IF VAPCOMM'=""!(ERXPCOMM'="")
- SET DIR("B")=$$PROVCOMM^PSOERUT4($SELECT($LENGTH(VAPCOMM):VAPCOMM,1:ERXPCOMM))
- +8 DO ^DIR
- KILL DIR
- +9 IF Y["^"
- SET PQUIT=1
- QUIT
- +10 SET USERCOMM=$$UP^XLFSTR(Y)
- KILL Y
- +11 IF USERCOMM'=$$PROVCOMM^PSOERUT4(USERCOMM)
- SET USERCOMM=$$PROVCOMM^PSOERUT4(USERCOMM)
- WRITE !,USERCOMM
- HANG 1
- +12 SET FDA(52.49,PSOIEN_",",30)=$$UP^XLFSTR(USERCOMM)
- DO FILE^DIE(,"FDA")
- KILL FDA
- +13 ;Saving the eRx Audit Log for Provider Comments
- +14 SET NEWVAL(1)=USERCOMM
- DO AUDLOG^PSOERXUT(+PSOIEN,"PROVIDER COMMENTS",DUZ,.NEWVAL)
- +15 QUIT
- VDRG5(PSOIEN,PSOIENS) ;
- +1 NEW PATIEN,PS55IEN,Y,DIE,DR,DA,FDA,ANS,PATSTAT,DONE
- +2 SET PATIEN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
- +3 IF 'PATIEN
- WRITE !!,"Patient has not been validated, cannot edit patient status",!
- QUIT
- +4 SET PSODFN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
- +5 SET PATSTAT=$$GET1^DIQ(55,PSODFN,3,"E")
- +6 DO KV
- SET DIR("B")=PATSTAT
- +7 SET DIR(0)="55,3"
- SET DIR("A")="PATIENT STATUS"
- +8 DO ^DIR
- KILL DIR
- +9 IF 'PATSTAT
- IF '+Y
- Begin DoDot:1
- +10 SET DONE=0
- +11 FOR
- Begin DoDot:2
- +12 WRITE !,"This is a required response. Enter '^' to exit"
- +13 SET DIR(0)="55,3"
- SET DIR("A")="PATIENT STATUS"
- DO ^DIR
- KILL DIR
- +14 IF +Y
- SET DONE=1
- QUIT
- +15 IF Y["^"
- SET PQUIT=1
- SET DONE=1
- QUIT
- End DoDot:2
- if DONE
- QUIT
- End DoDot:1
- +16 SET ANS=$PIECE(Y,"^",1)
- +17 SET FDA(55,PSODFN_",",3)=ANS
- +18 DO FILE^DIE(,"FDA","ERR")
- KILL FDA,ERR
- +19 QUIT
- +20 ;PSO*7.0*551 - BEGIN CHANGE - SWITCHING THE ORDER OF VDRG6 AND VDRG7. QUANTITY PROMPT WILL NOW COME BEFORE DAY SUPPLY.
- VDRG6(PSOIEN,PSOIENS) ;
- +1 NEW DIR,PSODRG,DRGMSG,ERXQTY,VAQTY,DIE,DA,DR,ERXQTYUM
- +2 SET PSODRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
- +3 IF PSODRG
- SET DRGMSG=$$GET1^DIQ(50,PSODRG,215,"E")
- +4 SET ERXQTY=$$GET1^DIQ(52.49,PSOIEN,5.1,"E")
- +5 SET ERXQTYUM=$$GET1^DIQ(52.49,PSOIEN,42,"E")
- +6 WRITE !,"eRx Quantity: "_ERXQTY_$SELECT(ERXQTYUM'="":" ("_ERXQTYUM_")",1:"")
- +7 SET VAQTY=$$GET1^DIQ(52.49,PSOIEN,20.1,"E")
- +8 SET PQUIT=$$QTYDSRFL^PSOERXU4(PSOIEN,2)
- +9 QUIT
- VDRG7(PSOIEN,PSOIENS) ;
- +1 NEW Y,ERXDS,DIE,DR,DA
- +2 ; dont prompt for days supply if we are editing 'all' fields or quantity (since quantity prompts for days supply)
- +3 SET ERXDS=$$GET1^DIQ(52.49,PSOIEN,5.5,"E")
- +4 WRITE !,"eRx Days Supply: "_ERXDS
- +5 SET PQUIT=$$QTYDSRFL^PSOERXU4(PSOIEN,1)
- +6 QUIT
- VDRG8(PSOIEN,PSOIENS) ;
- +1 NEW Y,ERXRFLS,DIE,DR,DA
- +2 SET ERXRFLS=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
- +3 IF $$GET1^DIQ(52.49,PSOIEN,.08,"I")="RE"
- IF $$GET1^DIQ(52.49,PSOIEN,52.1,"I")="R"
- SET ERXRFLS=ERXRFLS-1
- IF ERXRFLS<1
- SET ERXRFLS=0
- +4 WRITE !,"eRx Refills: "_ERXRFLS
- +5 SET PQUIT=$$QTYDSRFL^PSOERXU4(PSOIEN,3)
- +6 QUIT
- VDRG9(PSOIEN,PSOIENS) ;
- +1 NEW Y,DIR,DIE,DR,DA
- +2 SET DIR("A")="PICKUP ROUTING"
- +3 SET DIR(0)="SO^M:MAIL;W:WINDOW"
- +4 IF $$GET1^DIQ(52.49,PSOIEN,20.4,"I")'=""
- SET DIR("B")=$$GET1^DIQ(52.49,PSOIEN,20.4,"I")
- +5 IF '$TEST
- SET DIR("B")="M"
- +6 DO ^DIR
- KILL DIR
- +7 IF Y["^"
- SET PQUIT=1
- QUIT
- +8 SET DIE="^PS(52.49,"
- SET DA=PSOIEN
- SET DR="20.4///"_Y
- DO ^DIE
- KILL DIE,DR,DA
- +9 QUIT
- VDRG10(PSOIEN,PSOIENS) ;
- +1 NEW DIC,Y,VACLIN,CURCLIN,DIE,DR,DA
- +2 SET CURCLIN=$$GET1^DIQ(52.49,PSOIEN,20.6,"E")
- +3 IF $$GET1^DIQ(59.7,1,102,"I")="MBM"
- IF 'CURCLIN
- IF $GET(PSOCLNC)
- SET CURCLIN=$$GET1^DIQ(44,PSOCLNC,.01)
- +4 IF '$LENGTH(CURCLIN)
- SET CURCLIN=$$GET1^DIQ(59,PSOSITE,10,"E")
- +5 SET DIC("B")=CURCLIN
- +6 SET DIC="^SC("
- SET DIC(0)="QEAMZ"
- SET DIC("A")="Select CLINIC: "
- +7 IF $$GET1^DIQ(59.7,1,102,"I")="MBM"
- SET DIC("S")="I '$P($G(^(""I"")),U,1)!$P($G(^(""I"")),U,2)"
- +8 DO ^DIC
- KILL DIC
- IF Y<1
- QUIT
- +9 IF ($DATA(DTOUT))!($DATA(DUOUT))
- SET PQUIT=1
- QUIT
- +10 SET VACLIN=$PIECE(Y,U)
- +11 SET DIE="^PS(52.49,"
- SET DA=PSOIEN
- SET DR="20.6////"_VACLIN
- DO ^DIE
- KILL DIE,DR,DA
- +12 KILL DTOUT,DUOUT
- +13 QUIT
- VDRG11(PSOIEN,PSOIENS) ;
- +1 NEW DIE,DR,DA,Y
- +2 SET DIE="^PS(52.49,"
- SET DA=PSOIEN
- SET DR="8"
- DO ^DIE
- KILL DIE,DR,DA
- +3 IF $ORDER(Y(0))
- SET PQUIT=1
- +4 QUIT
- +5 ; display erx info
- +6 ; DFLG - display flag
- +7 ; 1 - drug sig comments
- +8 ; ""- all
- DERX1(PSOIEN,PSOIENS,DFLG) ;
- +1 DO DSPERX^PSOERUT(PSOIEN)
- WRITE !
- +2 ;D DERX1^PSOERXU4(PSOIEN,PSOIENS,$G(DFLG))
- +3 QUIT