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

PSOERXD2.m

Go to the documentation of this file.
  1. 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
  1. SBN ;
  1. N Y,ERXIEN
  1. S Y=$P(XQORNOD(0),"=",2)
  1. ;
  1. I +Y'=1,'$$GET1^DIQ(52.49,PSOIEN,3.2,"I")!'$D(^PS(52.49,PSOIEN,21)) D S VALMBCK="R" Q
  1. . S VALMSG="You must update the Dispense Drug first!" W $C(7)
  1. ;
  1. I Y']"" S VALMBCK="R" Q
  1. D EDIT^PSOERX1A("D",Y)
  1. S VALMBCK="R"
  1. Q
  1. VDRG1(PSOIEN,PSOIENS) ;
  1. N VANDRG,VAODRG,DIE,DA,DR,AUTOVAL,DIC,Y,QTLOOP,SELDRG,VDRG,VANDRG,VAOI,PATINST,FIELD,MTYPE,RESTYPE,ERXSTATA,NEWVAL,ERXMSG,FDA
  1. Q:'$G(PSOIEN)
  1. S VAODRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
  1. S AUTOVAL=$$GET1^DIQ(52.49,PSOIEN,1.4,"I")
  1. S MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
  1. S RESTYPE=$$GET1^DIQ(52.49,PSOIEN,52.1,"E")
  1. S ERXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
  1. I '$$GET1^DIQ(52.49,PSOIEN,3.2,"I") S XQORM("B")="Edit"
  1. 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
  1. ; for now allow user to search by drug name. may enhance screening in the future.
  1. S DIC(0)="AEMQ",DIC=50,DIC("S")="I $$ACTIVE^PSOERXA0(Y),($$OUTPAT^PSOERXA0(Y))"
  1. I VAODRG]"" S DIC("B")=$$GET1^DIQ(50,+VAODRG,.01,"E")
  1. S (PQUIT,SELDRG)=0
  1. F D ^DIC D I PQUIT!SELDRG Q
  1. . I $G(DUOUT)!($P(Y,U)<1) S PQUIT=1 Q
  1. . D PRDRVAL^PSOERXUT(.ERXMSG,"ED",PSOIEN,0,$P(Y,U))
  1. . I 'ERXMSG D I $P(ERXMSG,"^",2)="B" S PQUIT=1 D PAUSE^PSOERXUT Q
  1. . . W !,"*********************************",$S($P(ERXMSG,"^",2)="W":" WARNING(S) ",1:"INVALID DRUG"),"***********************************"
  1. . . S I=0 F S I=$O(ERXMSG(I)) Q:'I W !,$P(ERXMSG(I),"^")
  1. . . W !,"********************************************************************************",$C(7)
  1. . S SELDRG=Y K DIC
  1. I PQUIT Q
  1. 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
  1. I Y="^"!(Y<1) S PQUIT=1 Q
  1. S DIE="^PS(52.49,",DA=PSOIEN,DR="3.2///"_$P(SELDRG,U,1)
  1. ; If VistA Drug change, auto-matched before, change DRUG STAT (AUTO-VAL) #1.4 to 2 (VALIDATED/EDITED)
  1. 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"
  1. D ^DIE
  1. ;Saving the eRx Audit Log for the Dispense Drug entered
  1. S NEWVAL(1)=$$GET1^DIQ(50,+SELDRG,.01)_" (NDC#: "_$$GETNDC^PSSNDCUT(+SELDRG)_")"
  1. D AUDLOG^PSOERXUT(+PSOIEN,"DRUG",DUZ,.NEWVAL)
  1. ;
  1. ; set the manual validation flag if the drug has been selected.
  1. S VANDRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
  1. I ERXSTAT="N" D UPDSTAT^PSOERXU1(PSOIEN,"I")
  1. I MTYPE="RE",ERXSTAT'="RXI" D UPDSTAT^PSOERXU1(PSOIEN,"RXI")
  1. ; if the drug has changed, update the manual validation by and date/time
  1. I VANDRG'="",VAODRG'=VANDRG D
  1. .S QTLOOP=0 F S QTLOOP=$O(^PS(52.49,PSOIEN,21,QTLOOP)) Q:'QTLOOP D
  1. ..S FDA(52.4921,QTLOOP_","_PSOIENS,.01)="@" D FILE^DIE(,"FDA") K FDA
  1. .; if the drug is the same, leave the manual validation,otherwise delete it.
  1. .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)="@"
  1. .D FILE^DIE(,"FDA") K FDA
  1. .I MTYPE="N" D UPDSTAT^PSOERXU1(PSOIEN,"I")
  1. ; get and file patient instructions
  1. S VDRG=VANDRG
  1. S VAOI=$$GET1^DIQ(50,VDRG,2.1,"I")
  1. S PATINST=$$GET1^DIQ(50.7,VAOI,7,"E")
  1. I $L(PATINST) D
  1. .S FDA(52.49,PSOIENS,27)=$G(PATINST)
  1. .;Saving the eRx Audit Log for Patient Instructions from Orderable Item
  1. .S NEWVAL(1)=PATINST
  1. .D AUDLOG^PSOERXUT(+PSOIEN,"PATIENT INSTRUCTIONS",DUZ,.NEWVAL)
  1. ;
  1. D FILE^DIE(,"FDA") K FDA
  1. Q
  1. VDRG2(PSOIEN,PSOIENS) ;
  1. N PSOQTS,PSOFROM,PSODOSE,PSONEW,PSODRUG,PSORXED,VERB,QTIEN,SFIENS,DOSE,PSODFN,CURDOSE,NEWDOSE,IENS,ENT,I
  1. S IENS=1_","_PSOIEN_","
  1. S PSODFN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
  1. I 'PSODFN D Q
  1. .W !,"Cannot continue with dosing instructions until patient has been matched." D DIRE^PSOERXX1
  1. .S PQUIT=1
  1. ; drug ien and orderable item ien
  1. D DERX1(PSOIEN,PSOIENS,1)
  1. S PSODRUG("IEN")=$$GET1^DIQ(52.49,PSOIEN,3.2,"I") Q:'PSODRUG("IEN")
  1. S PSODRUG("OI")=$$GET1^DIQ(50,PSODRUG("IEN"),2.1,"I") Q:'PSODRUG("OI")
  1. ;
  1. ; Retrieving Existing Dosage
  1. K PSORXED D ERXDOSE^PSOERUT4(PSOIEN,.PSORXED)
  1. ;
  1. S CURDOSE=$$GET1^DIQ(52.4921,IENS,9,"E")
  1. ; SET PSOFROM=PENDING so the dosage list will activate and present to the user
  1. S ENT=0,PSOFROM="PENDING"
  1. COMPLEX ; This line tag is used for Complex Doses (Loop back here from below)
  1. S ENT=ENT+1,PSORXED("ENT")=ENT
  1. D DOSE^PSSORPH(.DOSE,PSODRUG("IEN"),"O",PSODFN)
  1. D ASK^PSOBKDED
  1. I $G(DOSE)']"" S PQUIT=1 Q
  1. I $$GET1^DIQ(52.49,PSOIEN,1,"E")="N" D UPDSTAT^PSOERXU1(PSOIEN,"I")
  1. I $G(VERB)]"" S PSORXED("VERB",ENT)=VERB G DUPD
  1. VER ;
  1. D DERX1(PSOIEN,PSOIENS,1)
  1. ;below logic brought over from VER^PSOOREDX
  1. D KV S DIR(0)="52.0113,8"
  1. S:$G(PSORXED("VERB",ENT))]"" DIR("B")=PSORXED("VERB",ENT)
  1. D ^DIR
  1. I X[U,$L(X)>1 S FIELD="VER" G JUMP
  1. G:$D(DTOUT)!($D(DUOUT)) EXQ
  1. I X="@" K PSORXED("VERB",ENT),VERB G DUPD
  1. S:X'="" (PSORXED("VERB",ENT),VERB)=X
  1. DUPD ;
  1. I $G(PSORXED("DOSE",ENT))'?.N&($G(PSORXED("DOSE",ENT))'?.N1".".N)!'DOSE("LD") K PSORXED("DOSE ORDERED",ENT),DUPD G NOU1
  1. ; below logic brought over from DUPD^PSOOREDX
  1. D KV S DIR(0)="52.0113,1",DIR("A")="DISPENSE UNITS PER DOSE"_$S($G(PSORXED("NOUN",ENT))]"":"("_PSORXED("NOUN",ENT)_")",1:"")
  1. I '$G(PSORXED("DOSE",ENT)),$G(PSORXED("DOSE",ENT-1)) S PSORXED("DOSE",ENT)=PSORXED("DOSE",ENT-1)
  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")
  1. D ^DIR I X[U,$L(X)>1 S FIELD="DUPD" G JUMP
  1. G:$D(DTOUT)!($D(DUOUT)) EXQ
  1. I X="@"!(X=0) W !,"Dispense Units Per Dose is Required!!",! G DUPD
  1. ;below logic brought over from STR^PSOOREDX
  1. 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,!
  1. S:X'="" (PSORXED("DOSE ORDERED",ENT),DUPD)=X
  1. NOU1 ;
  1. G:'$G(PSORXED("DOSE ORDERED",ENT)) RTE
  1. D CNON^PSOERXD3
  1. N PSONDEF
  1. I $G(NOUN)]"" S PSORXED("NOUN",ENT)=NOUN
  1. NOU ;
  1. ;below logic brought over from NOU^PSOOREDX
  1. D KV S DIR(0)="52.0113,3"
  1. S DIR("B")=$S($G(NOUN)]"":NOUN,1:$G(PSORXED("NOUN",ENT))) K:DIR("B")="" DIR("B")
  1. S PSONDEF=$G(DIR("B"))
  1. D ^DIR
  1. I X[U,$L(X)>1 S FIELD="NOU" G JUMP
  1. G:$D(DTOUT)!($D(DUOUT)) EXQ
  1. I X="@" K PSORXED("NOUN",ENT),NOUN G RTE
  1. I X'="",$G(PSONDEF)="" S NOUN=X
  1. I X'="",$G(PSONDEF)'=X S NOUN=X
  1. S:X'="" PSORXED("NOUN",ENT)=X
  1. ;
  1. RTE ;
  1. N CURTE,ERXRTE
  1. S CURTE=$$GET1^DIQ(52.4921,ENT_","_PSOIEN_",",10,"E") S PSORXED("ROUTE",ENT)=CURTE
  1. K JUMP
  1. S ROU="PSOERXD2" D RTE2^PSOERXD3 K ROU
  1. K ROU
  1. I $G(JUMP) K JUMP G JUMP
  1. G:$D(DTOUT)!($D(DUOUT)) EXQ
  1. ;
  1. SCH ;
  1. K PSOSCH,DIR,CURSCH,NEWSCH
  1. I '$D(ENT) S ENT=PSORXED("ENT")
  1. S CURSCH=$$GET1^DIQ(52.4921,ENT_","_PSOIEN_",",1,"E") I CURSCH]"" S DIR("B")=CURSCH
  1. I $G(DIR("B"))="",$$GET1^DIQ(50.7,+$G(PSODRUG("OI")),.08)'="" S DIR("B")=$$GET1^DIQ(50.7,+$G(PSODRUG("OI")),.08)
  1. 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"
  1. D ^DIR
  1. I X[U,$L(X)>1 S FIELD="SCH" G JUMP
  1. G:$D(DTOUT)!($D(DUOUT)) EXQ
  1. S SCH=$$SCHASL^PSOORED5(Y) D SCH^PSOSIG I $G(SCH)']""!($D(DTOUT))!($D(DUOUT)) G SCH
  1. S PSORXED("SCHEDULE",ENT)=SCH IF $G(SCHEX)'="" W " ("_SCHEX_")" K SCH,SCHEX,X,Y,PSOSCH
  1. S:PSORXED("ENT")<ENT PSORXED("ENT")=ENT
  1. S PSORXED("SCHEDULE",ENT)=$$UP^XLFSTR(PSORXED("SCHEDULE",ENT))
  1. ;
  1. DUR D KV K EXP
  1. S DIR(0)="52.0113,4",DIR("A")="LIMITED DURATION (IN DAYS, HOURS OR MINUTES)"
  1. S DIR("B")=$S($G(PSORXED("DURATION",ENT))]"":PSORXED("DURATION",ENT),1:"") K:DIR("B")="" DIR("B")
  1. D ^DIR I X[U,$L(X)>1 S FIELD="DUR" G JUMP
  1. G:$D(DTOUT)!($D(DUOUT)) EXQ
  1. D DUR1^PSOOREDX
  1. ;
  1. CON D CON^PSOOREDX I X[U,$L(X)>1 S FIELD="CON" G JUMP
  1. G:$D(DTOUT)!($D(DUOUT)) EXQ
  1. I X="@",$G(PSORXED("CONJUNCTION",ENT))="" W !,?10,"Invalid Entry - nothing to delete!!" G CON
  1. S:X'=""&(X'="@") PSORXED("CONJUNCTION",ENT)=Y
  1. I X="@" D CON1^PSOOREDX G:$D(DIRUT) EXQ G:'Y CON N CKX S CKX=1 D UPD^PSOOREDX G CON
  1. I '$$DUROK^PSOORED3(.PSORXED,ENT) D G DUR
  1. . W !!,"Duration is required for the dosage entered prior to the THEN conjunction.",$C(7),!
  1. I $G(PSORXED("CONJUNCTION",ENT))]"" K DIR G COMPLEX
  1. ;
  1. S P01=$S($L($G(PSORXED("DOSE ORDERED",1))):$G(PSORXED("DOSE ORDERED",1))_"&"_$G(PSORXED("NOUN",1)),1:$G(PSORXED("DOSE",1)))
  1. I '$L(P01) D Q
  1. . W !,"Dosage is required. Please re-enter the dosing instructions." S DIR(0)="W" D ^DIR D EX Q
  1. ;
  1. N SIG,SIGDAT,SLOOP,P01,I,DDONE,EDFLG
  1. S X=$G(PSORXED("INS")) D SIG^PSOHELP S:$G(INS1)]"" PSORXED("SIG")=$E(INS1,2,9999999)
  1. D EN^PSOFSIG(.PSORXED)
  1. ; delete existing SIG
  1. S SLOOP=0 F S SLOOP=$O(^PS(52.49,PSOIEN,"SIG",SLOOP)) Q:'SLOOP D
  1. . S FDA(52.4926,SLOOP_","_PSOIEN_",",.01)="@"
  1. I $D(FDA) D FILE^DIE(,"FDA") K FDA
  1. ; file sig into VA DISPENSING INSTRUCTIONS multiple
  1. S SLOOP=0 F S SLOOP=$O(SIG(SLOOP)) Q:'SLOOP D
  1. . S SIGDAT=$G(SIG(SLOOP)) Q:SIGDAT=""
  1. . S SFDA(52.4926,"+1,"_PSOIENS,.01)=SIGDAT D UPDATE^DIE(,"SFDA",,"SERR") K SFDA
  1. ;
  1. ;Saving the eRx Audit Log for the SIG
  1. D AUDLOG^PSOERXUT(+PSOIEN,"SIG",DUZ,.SIG)
  1. ;
  1. ; Deleting Existing Dosage
  1. N DIK,DA S DIK="^PS(52.49,"_PSOIEN_",21,",DA(1)=PSOIEN
  1. S DA=0 F S DA=$O(^PS(52.49,PSOIEN,21,DA)) Q:'DA D ^DIK
  1. ; Saving Edited Dosage
  1. K FDA
  1. F I=1:1:ENT D
  1. . 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)))
  1. . S FDA(52.4921,"+1,"_PSOIENS,1)=$G(PSORXED("SCHEDULE",I))
  1. . S FDA(52.4921,"+1,"_PSOIENS,2)=$G(PSORXED("DURATION",I))
  1. . S FDA(52.4921,"+1,"_PSOIENS,6)=$S($G(PSORXED("CONJUNCTION",I))="T":"S",1:$G(PSORXED("CONJUNCTION",I)))
  1. . S FDA(52.4921,"+1,"_PSOIENS,8)=$G(PSORXED("DOSE",I))
  1. . S FDA(52.4921,"+1,"_PSOIENS,9)=$G(PSORXED("DOSE ORDERED",I))
  1. . S FDA(52.4921,"+1,"_PSOIENS,10)=$G(PSORXED("ROUTE",I))
  1. . S FDA(52.4921,"+1,"_PSOIENS,11)=$G(PSORXED("UNITS",I))
  1. . S FDA(52.4921,"+1,"_PSOIENS,12)=$G(PSORXED("NOUN",I))
  1. . S FDA(52.4921,"+1,"_PSOIENS,13)=$G(PSORXED("VERB",I))
  1. . D UPDATE^DIE("","FDA") K FDA
  1. ;
  1. N UNEXINS,UNEXARY
  1. D SETUNEX^PSOERXD3
  1. ;
  1. EX ;
  1. 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
  1. KV K DTOUT,DUOUT,DIR,DIRUT,DA
  1. Q
  1. EXQ ;
  1. K PSORXED,PSOSIGFL M PSORXED=PSODOSE D EN^PSOFSIG(.PSORXED) D MP1
  1. I $D(PSOBDR) M PSODRUG=PSOBDR K PSOBDR,PSOBDRG
  1. S PQUIT=1
  1. G EX Q
  1. MP1 ;
  1. S VALMSG="eRx Not Updated!"
  1. Q
  1. JUMP ;jump to fields
  1. I $L($E(X,2,99))<3 W !,"Field Name Must Be At Least 3 Characters in Length",! G @FIELD
  1. D FNM^PSOERXD3
  1. I FLDNM']"" K X,NM,FLDNM W !,"INVALID FIELD NAME. PLEASE TRY AGAIN!",! G @FIELD
  1. 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
  1. D KV S DIR("A")="Select Field to Edit by number",DIR(0)="NO^1:"_AR1 D ^DIR G:$D(DIRUT) @FIELD
  1. D JFN^PSOERXD3
  1. I $G(FLDNM)'="",$T(@FLDNM)'="" G @FLDNM
  1. I $G(FIELD)'="",$T(@FIELD)'="" G @FIELD
  1. G EX
  1. Q
  1. VDRG3(PSOIEN,PSOIENS) ;
  1. N DIR,Y,X,PATINST,ERXDRUG,VDRG,VAOI,FDA,NEWVAL,DEL,INS1,PSODIR,DA
  1. D DERX1(PSOIEN,PSOIENS,1)
  1. S ERXDRUG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
  1. S PATINST=$$GET1^DIQ(52.49,PSOIEN,27,"E")
  1. I '$L(PATINST) D
  1. .S VDRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I") Q:'VDRG
  1. .S VAOI=$$GET1^DIQ(50,VDRG,2.1,"I") Q:'VAOI
  1. .S PATINST=$$GET1^DIQ(50.7,VAOI,7,"E")
  1. D KV S DIR(0)="52.49,27",DIR("A")="VA PATIENT INSTRUCTIONS"
  1. I $L(PATINST) S DIR("B")=PATINST
  1. D ^DIR K DIR
  1. I Y["^" S PQUIT=1 Q
  1. S (INS1,PSODIR("INS"))="",DEL=0 I X="@" S DEL=1
  1. I 'DEL D
  1. . S (X,PSODIR("INS"))=Y D SIG^PSOHELP S $E(INS1)=""
  1. . I $G(INS1)'="",$$UP^XLFSTR($G(PSODIR("INS")))'=$$UP^XLFSTR(INS1) W !,INS1 H 1
  1. . I $G(INS1)="",$G(PSODIR("INS"))'="" S INS1=PSODIR("INS")
  1. I $G(INS1)'=""!DEL D
  1. . S FDA(52.49,PSOIEN_",",27)=$S(DEL:"@",1:$$UP^XLFSTR($G(INS1))) D FILE^DIE(,"FDA") K FDA
  1. . ;Saving the eRx Audit Log for Patient Instructions (Manually entered)
  1. . S NEWVAL(1)=$$UP^XLFSTR($G(INS1)) D AUDLOG^PSOERXUT(+PSOIEN,"PATIENT INSTRUCTIONS",DUZ,.NEWVAL)
  1. Q
  1. VDRG4(PSOIEN,PSOIENS) ;
  1. N DIR,Y,USERCOMM,VPATINST,UFLAG,VAPCOMM,ERXPCOMM,FDA,NEWVAL
  1. ; POSSIBLE FUTURE IMPLEMENTATION OF ERX DETAILS
  1. S VPATINST=$$GET1^DIQ(52.49,PSOIEN,27,"E")
  1. S ERXPCOMM=$$GET1^DIQ(52.49,PSOIEN,8,"E")
  1. S VAPCOMM=$$GET1^DIQ(52.49,PSOIEN,30,"E")
  1. D KV S DIR(0)="FO^1:240",DIR("A")="VA PROVIDER COMMENTS"
  1. I VAPCOMM'=""!(ERXPCOMM'="") S DIR("B")=$$PROVCOMM^PSOERUT4($S($L(VAPCOMM):VAPCOMM,1:ERXPCOMM))
  1. D ^DIR K DIR
  1. I Y["^" S PQUIT=1 Q
  1. S USERCOMM=$$UP^XLFSTR(Y) K Y
  1. I USERCOMM'=$$PROVCOMM^PSOERUT4(USERCOMM) S USERCOMM=$$PROVCOMM^PSOERUT4(USERCOMM) W !,USERCOMM H 1
  1. S FDA(52.49,PSOIEN_",",30)=$$UP^XLFSTR(USERCOMM) D FILE^DIE(,"FDA") K FDA
  1. ;Saving the eRx Audit Log for Provider Comments
  1. S NEWVAL(1)=USERCOMM D AUDLOG^PSOERXUT(+PSOIEN,"PROVIDER COMMENTS",DUZ,.NEWVAL)
  1. Q
  1. VDRG5(PSOIEN,PSOIENS) ;
  1. N PATIEN,PS55IEN,Y,DIE,DR,DA,FDA,ANS,PATSTAT,DONE
  1. S PATIEN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
  1. I 'PATIEN W !!,"Patient has not been validated, cannot edit patient status",! Q
  1. S PSODFN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
  1. S PATSTAT=$$GET1^DIQ(55,PSODFN,3,"E")
  1. D KV S DIR("B")=PATSTAT
  1. S DIR(0)="55,3",DIR("A")="PATIENT STATUS"
  1. D ^DIR K DIR
  1. I 'PATSTAT,'+Y D
  1. .S DONE=0
  1. .F D Q:DONE
  1. ..W !,"This is a required response. Enter '^' to exit"
  1. ..S DIR(0)="55,3",DIR("A")="PATIENT STATUS" D ^DIR K DIR
  1. ..I +Y S DONE=1 Q
  1. ..I Y["^" S PQUIT=1,DONE=1 Q
  1. S ANS=$P(Y,"^",1)
  1. S FDA(55,PSODFN_",",3)=ANS
  1. D FILE^DIE(,"FDA","ERR") K FDA,ERR
  1. Q
  1. ;PSO*7.0*551 - BEGIN CHANGE - SWITCHING THE ORDER OF VDRG6 AND VDRG7. QUANTITY PROMPT WILL NOW COME BEFORE DAY SUPPLY.
  1. VDRG6(PSOIEN,PSOIENS) ;
  1. N DIR,PSODRG,DRGMSG,ERXQTY,VAQTY,DIE,DA,DR,ERXQTYUM
  1. S PSODRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
  1. I PSODRG S DRGMSG=$$GET1^DIQ(50,PSODRG,215,"E")
  1. S ERXQTY=$$GET1^DIQ(52.49,PSOIEN,5.1,"E")
  1. S ERXQTYUM=$$GET1^DIQ(52.49,PSOIEN,42,"E")
  1. W !,"eRx Quantity: "_ERXQTY_$S(ERXQTYUM'="":" ("_ERXQTYUM_")",1:"")
  1. S VAQTY=$$GET1^DIQ(52.49,PSOIEN,20.1,"E")
  1. S PQUIT=$$QTYDSRFL^PSOERXU4(PSOIEN,2)
  1. Q
  1. VDRG7(PSOIEN,PSOIENS) ;
  1. N Y,ERXDS,DIE,DR,DA
  1. ; dont prompt for days supply if we are editing 'all' fields or quantity (since quantity prompts for days supply)
  1. S ERXDS=$$GET1^DIQ(52.49,PSOIEN,5.5,"E")
  1. W !,"eRx Days Supply: "_ERXDS
  1. S PQUIT=$$QTYDSRFL^PSOERXU4(PSOIEN,1)
  1. Q
  1. VDRG8(PSOIEN,PSOIENS) ;
  1. N Y,ERXRFLS,DIE,DR,DA
  1. S ERXRFLS=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
  1. 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
  1. W !,"eRx Refills: "_ERXRFLS
  1. S PQUIT=$$QTYDSRFL^PSOERXU4(PSOIEN,3)
  1. Q
  1. VDRG9(PSOIEN,PSOIENS) ;
  1. N Y,DIR,DIE,DR,DA
  1. S DIR("A")="PICKUP ROUTING"
  1. S DIR(0)="SO^M:MAIL;W:WINDOW"
  1. I $$GET1^DIQ(52.49,PSOIEN,20.4,"I")'="" S DIR("B")=$$GET1^DIQ(52.49,PSOIEN,20.4,"I")
  1. E S DIR("B")="M"
  1. D ^DIR K DIR
  1. I Y["^" S PQUIT=1 Q
  1. S DIE="^PS(52.49,",DA=PSOIEN,DR="20.4///"_Y D ^DIE K DIE,DR,DA
  1. Q
  1. VDRG10(PSOIEN,PSOIENS) ;
  1. N DIC,Y,VACLIN,CURCLIN,DIE,DR,DA
  1. S CURCLIN=$$GET1^DIQ(52.49,PSOIEN,20.6,"E")
  1. I $$GET1^DIQ(59.7,1,102,"I")="MBM",'CURCLIN,$G(PSOCLNC) S CURCLIN=$$GET1^DIQ(44,PSOCLNC,.01)
  1. I '$L(CURCLIN) S CURCLIN=$$GET1^DIQ(59,PSOSITE,10,"E")
  1. S DIC("B")=CURCLIN
  1. S DIC="^SC(",DIC(0)="QEAMZ",DIC("A")="Select CLINIC: "
  1. I $$GET1^DIQ(59.7,1,102,"I")="MBM" S DIC("S")="I '$P($G(^(""I"")),U,1)!$P($G(^(""I"")),U,2)"
  1. D ^DIC K DIC I Y<1 Q
  1. I ($D(DTOUT))!($D(DUOUT)) S PQUIT=1 Q
  1. S VACLIN=$P(Y,U)
  1. S DIE="^PS(52.49,",DA=PSOIEN,DR="20.6////"_VACLIN D ^DIE K DIE,DR,DA
  1. K DTOUT,DUOUT
  1. Q
  1. VDRG11(PSOIEN,PSOIENS) ;
  1. N DIE,DR,DA,Y
  1. S DIE="^PS(52.49,",DA=PSOIEN,DR="8" D ^DIE K DIE,DR,DA
  1. I $O(Y(0)) S PQUIT=1
  1. Q
  1. ; display erx info
  1. ; DFLG - display flag
  1. ; 1 - drug sig comments
  1. ; ""- all
  1. DERX1(PSOIEN,PSOIENS,DFLG) ;
  1. D DSPERX^PSOERUT(PSOIEN) W !
  1. ;D DERX1^PSOERXU4(PSOIEN,PSOIENS,$G(DFLG))
  1. Q