- PSOERXU4 ;ALB/BLB - eRx utilities ; 12/21/2020
- ;;7.0;OUTPATIENT PHARMACY;**520,508,551,581,635,617,651,700,746**;DEC 1997;Build 106
- ;
- Q
- DERX1(PSOIEN,PSOIENS,DFLAG) ;
- N EDRG,ERXDAT,ESIG,COMM,SUBS,DFORM,DSTR,QQUAL,POTUC,QTY,DAYS,REFILL,COMMARY,SIGARY,ERXRFLS,I,ERXDSUB
- N S2017,MIEN,MTYPE,SGLOOP,RESVAL,DFLG
- S S2017=$$GET1^DIQ(52.49,PSOIEN,312.1,"I")
- D GETS^DIQ(52.49,PSOIENS,".03;.08;3.1;4.6;4.8;5.1;5.2;5.4;5.5;5.6;5.7;5.8;7;8;41;42;43","E","ERXDAT")
- S DFLG=$G(DFLAG,"")
- S MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
- S RESVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
- S EDRG=$G(ERXDAT(52.49,PSOIENS,3.1,"E"))
- S ESIG=$G(ERXDAT(52.49,PSOIENS,7,"E"))
- S COMM=$G(ERXDAT(52.49,PSOIENS,8,"E"))
- S SUBS=$G(ERXDAT(52.49,PSOIENS,5.8,"E"))
- S DFORM=$G(ERXDAT(52.49,PSOIENS,41,"E"))
- S DSTR=$G(ERXDAT(52.49,PSOIENS,43,"E"))
- I 'S2017 S QQUAL=$G(ERXDAT(52.49,PSOIENS,5.2,"E"))
- I S2017 D
- .S MIEN=$O(^PS(52.49,PSOIEN,311,0))
- .S QQUAL=$$GET1^DIQ(52.49311,MIEN_","_PSOIEN_",",2.2,"I"),QQUAL=$$GET1^DIQ(52.45,QQUAL,.02,"E")
- S POTUC=$G(ERXDAT(52.49,PSOIENS,42,"E"))
- S QTY=$G(ERXDAT(52.49,PSOIENS,5.1,"E"))
- S DAYS=$G(ERXDAT(52.49,PSOIENS,5.5,"E"))
- S REFILL=$G(ERXDAT(52.49,PSOIENS,5.6,"E"))
- I 'S2017 D
- .I REFILL="" D
- ..S REFILL=$G(ERXDAT(52.49,PSOIENS,5.7,"I"))
- I MTYPE="RE",RESVAL="R",REFILL>0 S REFILL=REFILL-1
- D TXT2ARY^PSOERXD1(.SIGARY,ESIG,,69)
- D TXT2ARY^PSOERXD1(.COMMARY,COMM,,65)
- W !,"eRx Drug: "_EDRG_" "_$P($$ERXDRSCH^PSOERXUT(PSOIENS),"^",2)
- I 'S2017 D
- .W !,"eRx Sig: "
- .S I=0 F S I=$O(SIGARY(I)) Q:'I D
- ..W $S(I>1:" "_SIGARY(I),1:SIGARY(I)),!
- I '$L(ESIG) W !
- I S2017 D
- .W !,"eRx Sig:"
- .S SGLOOP=0 F S SGLOOP=$O(^PS(52.49,PSOIEN,311,MIEN,8,SGLOOP)) Q:'SGLOOP D
- ..W !,$G(^PS(52.49,PSOIEN,311,MIEN,8,SGLOOP,0))
- W !!,"eRx Notes: "
- S I=0 F S I=$O(COMMARY(I)) Q:'I D
- .W $S(I>1:" "_COMMARY(I),1:COMMARY(I)),!
- I '$L(COMM) W !
- Q:DFLG=1
- W "Drug Form: "_DFORM,?40,"Strength: "_DSTR
- W !,"Code List Qualifier: "_QQUAL,?40,"Quantity Unit of Measure: "_POTUC
- S ERXDSUB=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")
- S ERXDSUB=$S(ERXDSUB=1:"NO",ERXDSUB=0:"YES",1:"")
- W !,"Substitutions? :"_ERXDSUB
- W !,"Qty: "_QTY,?25,"Days Supply: "_DAYS,?55,"Refills: "_REFILL,!
- Q
- REM ;
- N MBMSITE,DIR,Y,PSSRET,PSOIENS,REMIEN,REMSTA,REMTXT,ERXRMIEN,DIC,X,RXSTAT,FDA
- S MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
- D FULL^VALM1
- S PSOIENS=PSOIEN_","
- S VALMBCK="R"
- S RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E") I RXSTAT="RJ"!(RXSTAT="RM")!($G(MBMSITE)&($E(RXSTAT,1,3)="REM"))!(RXSTAT="PR") D Q
- .W !!,"Cannot remove a prescription with a status of 'Rejected', 'Removed',",!,"or 'Processed",!
- .S DIR(0)="E" D ^DIR
- W ! S DIC="^PS(52.45,",DIC(0)="AEMQ",DIC("S")="I $D(^PS(52.45,""TYPE"",""REM"",Y))",DIC("A")="Select REMOVAL reason code: "
- D ^DIC K DIC
- I $P(Y,U)<1 Q
- S REMIEN=$P(Y,U),REMSTA=$P(Y,U,2)
- I +$G(REMIEN)<1 W !,"Removal reason code required!" S DIR(0)="E" D ^DIR K DIR Q
- K X,Y S DIR(0)="FO^1:70",DIR("A")="Additional Comments (Optional)" D ^DIR K DIR
- Q:Y="^"
- S REMTXT=$G(Y)
- W ! S DIR(0)="YO",DIR("A")="Would you like to 'Remove' eRx #"_$$GET1^DIQ(52.49,PSOIEN,.01,"E"),DIR("B")="Y" D ^DIR K DIR
- Q:'Y
- I '$G(MBMSITE) D
- . K FDA S FDA(52.4919,"+1,"_PSOIENS,.01)=$$NOW^XLFDT,FDA(52.4919,"+1,"_PSOIENS,.02)=REMIEN
- . S FDA(52.4919,"+1,"_PSOIENS,.03)=DUZ,FDA(52.4919,"+1,"_PSOIENS,1)=REMTXT
- . D UPDATE^DIE(,"FDA") K FDA
- ; SET THE ERX STATUS TO THE REMOVAL REASON
- D UPDSTAT^PSOERXU1(PSOIEN,$S('$G(MBMSITE):"RM",1:REMSTA),REMTXT)
- ;allow user to perform a batch removal of eRx for a patient with the same provider if it comes in on the same day
- D BATCHREM^PSOERX1H(PSOIEN,REMIEN,REMTXT,"R") ; "R"-remove
- K @VALMAR D REF^PSOERSE1
- Q
- ; unremove eRx
- UNREM ;
- N DIR,Y,DA,DIE,DR,HCOMM,PSSRET,PSOIENS,REMIEN,REMSTA,REMTXT,ERXRMIEN,DIC,X,RXSTAT,SEQ,NEWSTA
- D FULL^VALM1
- S PSOIENS=PSOIEN_","
- S VALMBCK="R"
- D CHKSTA I RXSTAT'="RM" D Q
- .W !!,"Cannot Un-Remove a prescription that the status is not 'Removed'"
- .S DIR(0)="E" D ^DIR
- HLD W !
- S DIC="^PS(52.45,",DIC(0)="AEMQ",DIC("S")="I $E($P(^PS(52.45,+Y,0),U))=""H""",DIC("B")="HUR"
- S DIC("A")="Select HOLD reason code: " D ^DIC K DIC
- I $P(Y,U)<1 Q ;if user ^
- S REMIEN=$P(Y,U)
- I +$G(REMIEN)<0 W !,"HOLD reason code required!" S DIR(0)="E" D ^DIR K DIR G HLD
- ; Add comment in 52.4919
- S DIR(0)="52.4919,1",DIR("A")="Additional Comments (Optional)" D ^DIR K DIR
- I Y="^" Q
- S HCOMM=$G(Y)
- S DIR(0)="YO",DIR("A")="Would you like to 'Un-Remove' eRx #"_$$GET1^DIQ(52.49,PSOIEN,.01,"E")
- S DIR("B")="Y" D ^DIR K DIR
- Q:'Y
- D UPDSTAT^PSOERXU1(PSOIEN,$$GET1^DIQ(52.45,REMIEN,.01),HCOMM)
- S DR="1///"_REMIEN,DIE="^PS(52.49,",DA=PSOIEN D ^DIE
- D BATCHREM^PSOERX1H(PSOIEN,REMIEN,HCOMM,"U") ; "U" - Un-remove
- K @VALMAR D REF^PSOERSE1 ;Refresh screen
- Q
- CHKSTA ; check if status is RM or type is "REM"
- S STAIEN=+$G(^PS(52.49,PSOIEN,1)),RXSTAT=$P(^PS(52.45,STAIEN,0),"^",1)
- I RXSTAT="RM" K STAIEN Q
- S RXSTAT=$S($P(^PS(52.45,STAIEN,0),"^",3)="REM":"RM",1:"") K STAIEN
- Q
- ; reject eRx
- REJ ;
- N MBMSITE,DIR,DIC,Y,PSSRET,PSOIENS,REMTXT,REJSTA,FULLTXT,ERXRJIEN,REJDESC,REJIEN,REJTXT,X,RXSTAT
- S MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
- D FULL^VALM1
- S PSOIENS=PSOIEN_","
- S VALMBCK="R"
- S RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E") I RXSTAT="RJ"!(RXSTAT="RM")!($G(MBMSITE)&($E(RXSTAT,1,3)="REM"))!(RXSTAT="PR") D Q
- .W !!,"Cannot reject a prescription with a status of 'Rejected', 'Removed',",!,"or 'Processed",!
- .S DIR(0)="E" D ^DIR
- S DIR(0)="YO",DIR("A")="Would you like to 'Reject' eRx #"_$$GET1^DIQ(52.49,PSOIEN,.01,"E"),DIR("B")="Y" D ^DIR K DIR
- Q:'Y
- S DIC="^PS(52.45,",DIC(0)="AEMQ",DIC("S")="I $D(^PS(52.45,""TYPE"",""REJ"",Y))",DIC("A")="Select REJECT reason code: "
- D ^DIC K DIC
- I $P(Y,U)<1 W !,"Reject reason required! eRx NOT rejected." S DIR(0)="E" D ^DIR K DIR Q
- S REJIEN=$P(Y,U),REJSTA=$P(Y,U,2)
- K X,Y,DIR
- S DIR(0)="FO^1:200",DIR("A")="Additional Comments (Optional)" D ^DIR K DIR
- Q:Y="^"
- ; if reject reason was entered, log the activity.
- S REJTXT=Y
- S REJDESC=$$GET1^DIQ(52.45,REJIEN,.02,"E")
- S FULLTXT=REJSTA_" "_REJDESC_" - Additional Comments: "_REJTXT
- D POST^PSOERXO1(PSOIEN,.PSSRET,900,"",$E(FULLTXT,1,295))
- ; if the post was unsuccessful, inform the user and quit.
- I $P(PSSRET(0),U)<1 W !,$P(PSSRET(0),U,2) S DIR(0)="E" D ^DIR K DIR Q
- I $D(PSSRET("errorMessage")) W !,PSSRET("errorMessage") S DIR(0)="E" D ^DIR K DIR Q
- W !!,"Rejection message sent." S DIR(0)="E" D ^DIR K DIR
- ; if post is successful, change the eRx status and log the status activity.
- S FDA(52.4919,"+1,"_PSOIENS,.01)=$$NOW^XLFDT
- S FDA(52.4919,"+1,"_PSOIENS,.02)=REJIEN
- S FDA(52.4919,"+1,"_PSOIENS,.03)=DUZ
- S FDA(52.4919,"+1,"_PSOIENS,1)=REJTXT
- D UPDATE^DIE(,"FDA") K FDA
- ; SET THE ERX STATUS TO THE REJECT REASON
- D UPDSTAT^PSOERXU1(PSOIEN,"RJ")
- Q
- QTYDSRFL(ERXIEN,EDTYP) ;
- ; ERXIEN - ien from 52.49
- ; EDTYP:
- ; 1 - DAYS SUPPLY
- ; 2 - QUANTITY
- ; 3 - REFILLS
- ; 4 - SCHEDULE/DOSAGE EDIT
- N PSODRUG,PSODIR,ERXDRUG,PSODFN,ERXIENS,FDA,CLOZPAT,PSOY,PATSTAT,Y,DONE,DIR,ANS,NWDAYSUP,NEWQTY,PSODRG,PSONEW,PQUIT
- S ERXIENS=ERXIEN_","
- ; setup drug array
- S ERXDRUG=$$GET1^DIQ(52.49,ERXIEN,3.2,"I") Q:'ERXDRUG 0
- S PSOY=ERXDRUG,PSOY(0)=$G(^PSDRUG(ERXDRUG,0))
- D SET^PSODRG
- S PSODRG=ERXDRUG
- ; set quanity, days supply, refill, and patient information
- S PSODFN=$$GET1^DIQ(52.49,ERXIEN,.05,"I")
- S PSODIR("QTY")=$$GET1^DIQ(52.49,ERXIEN,20.1,"E")
- S PSODIR("DAYS SUPPLY")=$$GET1^DIQ(52.49,ERXIEN,20.2,"E")
- S PSODIR("# OF REFILLS")=$$GET1^DIQ(52.49,ERXIEN,20.5,"E")
- ; Decrement # of refills if this is a RxRenewalResponse with a response type of 'Replace'
- ; only decrement if field 20.5 and 5.6 are the same.
- I PSODIR("# OF REFILLS")>0,$$GET1^DIQ(52.49,ERXIEN,.08,"I")="RE",$$GET1^DIQ(52.49,ERXIEN,52.1,"I")="R" D
- .I PSODIR("# OF REFILLS")=$$GET1^DIQ(52.49,ERXIEN,5.6,"E") D
- ..S PSODIR("# OF REFILLS")=$G(PSODIR("# OF REFILLS"))-1
- S PSODIR("DFLG")=0
- S PATSTAT=$$GET1^DIQ(55,PSODFN,3,"E")
- I '$L(PATSTAT) D
- .S DONE=0
- .F D Q:DONE
- ..W !,"This is a required response. Enter '^' to exit"
- ..K DA 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
- S PSODIR("PATIENT STATUS")=$P($G(^PS(55,PSODFN,"PS")),U)
- S X=$G(PSODIR("PATIENT STATUS"))
- I X D
- .S DIC=53,DIC(0)="QXZ" D ^DIC K DIC
- .S:+Y>0 PSODIR("PTST NODE")=Y(0)
- I $P($G(^PSDRUG(PSODRG,"CLOZ1")),"^")="PSOCLO1" D
- .S CLOZPAT=$O(^YSCL(603.01,"C",PSODFN,0)) Q:'CLOZPAT
- .S CLOZPAT=$P(^YSCL(603.01,CLOZPAT,0),"^",3)
- .S CLOZPAT=$S(CLOZPAT="M":2,CLOZPAT="B":1,1:0)
- I EDTYP=1 D
- .S:'$G(PSODIR("DAYS SUPPLY")) NWDAYSUP=$$DAYSCHK(.PSODRUG,.PSODIR)
- .I $G(NWDAYSUP) S PSODIR("DAYS SUPPLY")=NWDAYSUP
- .D DAYS^PSODIR1(.PSODIR) D FILE
- .K QTYDSRFL
- I EDTYP=2 S PSONEW("FLD")=7 D
- .I $$GET1^DIQ(52.49,PSOIEN,20.1)'="" D
- ..S PSODIR("QTY")=$$GET1^DIQ(52.49,PSOIEN,20.1)
- .E S NEWQTY=$$QTYCHECK,PSODIR("QTY")=NEWQTY
- .D QTY^PSODIR1(.PSODIR),FILE
- .K QTYARY
- I EDTYP=3 S PSONEW("FLD")=9 D REFILL^PSODIR1(.PSODIR)
- I $G(PSODIR("DFLG"))=1 Q 1
- S QTYDSRFL("QTY")=$G(PSODIR("QTY"))
- D FILE
- Q 0
- FILE ;
- N NEWVAL
- S FDA(52.49,ERXIENS,20.1)=$G(PSODIR("QTY"))
- S FDA(52.49,ERXIENS,20.2)=$G(PSODIR("DAYS SUPPLY"))
- S FDA(52.49,ERXIENS,20.5)=$G(PSODIR("# OF REFILLS"))
- D FILE^DIE(,"FDA") K FDA
- ;Saving the eRx Audit Log for QTY, DAYS SUPPLY & # OF REFILLS
- I $G(PSODIR("QTY"))'="" S NEWVAL(1)=$G(PSODIR("QTY")) D AUDLOG^PSOERXUT(+PSOIEN,"QTY",DUZ,.NEWVAL)
- I $G(PSODIR("DAYS SUPPLY"))'="" S NEWVAL(1)=$G(PSODIR("DAYS SUPPLY")) D AUDLOG^PSOERXUT(+PSOIEN,"DAYS SUPPLY",DUZ,.NEWVAL)
- I $G(PSODIR("# OF REFILLS"))'="" S NEWVAL(1)=$G(PSODIR("# OF REFILLS")) D AUDLOG^PSOERXUT(+PSOIEN,"# OF REFILLS",DUZ,.NEWVAL)
- Q
- DAYSCHK(PSODRUG,PSODIR) ; auto calculate days supply based off quantity.
- N QTYDSRFL,DAYSUP,I,ADUR,IENS
- N QTYDSRFL,VAL,DOSE
- F DOSE=1:1 Q:'$D(^PS(52.49,PSOIEN,21,DOSE)) D
- . S QTYDSRFL("DOSE ORDERED",DOSE)=$$GET1^DIQ(52.4921,DOSE_","_PSOIEN_",",9,"E")_"^"
- . S QTYDSRFL("SCHEDULE",DOSE)=$$GET1^DIQ(52.4921,DOSE_","_PSOIEN_",",1,"E")
- . S QTYDSRFL("DURATION",DOSE)=$$GET1^DIQ(52.4921,DOSE_","_PSOIEN_",",2,"E")
- . S QTYDSRFL("CONJUNCTION",DOSE)=$$GET1^DIQ(52.4921,DOSE_","_PSOIEN_",",6,"E")
- I '$G(QTYDSRFL("DOSE ORDERED",1)) Q 0
- S QTYDSRFL("PATIENT")=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
- S QTYDSRFL("DRUG")=$G(PSODRUG("IEN"))
- S QTYDSRFL("QTY")=$G(PSODIR("QTY"))
- D QTYX^PSOSIG(.QTYDSRFL)
- S DAYSUP=$G(QTYDSRFL("DAYS SUPPLY"))
- Q DAYSUP
- ;
- QTYCHECK(PSODRUG,PSODIR) ; return qty for days supply
- ; VAL: quantity
- N QTYARY,VAL,DOSE
- F DOSE=1:1 Q:'$D(^PS(52.49,PSOIEN,21,DOSE)) D
- . S QTYARY("DOSE ORDERED",DOSE)=$$GET1^DIQ(52.4921,DOSE_","_PSOIEN_",",9,"E")_"^"
- . S QTYARY("SCHEDULE",DOSE)=$$GET1^DIQ(52.4921,DOSE_","_PSOIEN_",",1,"E")
- . S QTYARY("DURATION",DOSE)=$$GET1^DIQ(52.4921,DOSE_","_PSOIEN_",",2,"E")
- . S QTYARY("CONJUNCTION",DOSE)=$$GET1^DIQ(52.4921,DOSE_","_PSOIEN_",",6,"E")
- I '$G(QTYARY("DOSE ORDERED",1)) Q ""
- S QTYARY("PATIENT")=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
- S QTYARY("DRUG")=$G(PSODRUG("IEN"))
- S QTYARY("DAYS SUPPLY")=$$GET1^DIQ(52.49,PSOIEN,20.2,"E")
- D QTYX^PSOSIG(.QTYARY)
- S VAL=$G(QTYARY("QTY"))
- Q VAL
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXU4 11385 printed Feb 18, 2025@23:55:32 Page 2
- PSOERXU4 ;ALB/BLB - eRx utilities ; 12/21/2020
- +1 ;;7.0;OUTPATIENT PHARMACY;**520,508,551,581,635,617,651,700,746**;DEC 1997;Build 106
- +2 ;
- +3 QUIT
- DERX1(PSOIEN,PSOIENS,DFLAG) ;
- +1 NEW EDRG,ERXDAT,ESIG,COMM,SUBS,DFORM,DSTR,QQUAL,POTUC,QTY,DAYS,REFILL,COMMARY,SIGARY,ERXRFLS,I,ERXDSUB
- +2 NEW S2017,MIEN,MTYPE,SGLOOP,RESVAL,DFLG
- +3 SET S2017=$$GET1^DIQ(52.49,PSOIEN,312.1,"I")
- +4 DO GETS^DIQ(52.49,PSOIENS,".03;.08;3.1;4.6;4.8;5.1;5.2;5.4;5.5;5.6;5.7;5.8;7;8;41;42;43","E","ERXDAT")
- +5 SET DFLG=$GET(DFLAG,"")
- +6 SET MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
- +7 SET RESVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
- +8 SET EDRG=$GET(ERXDAT(52.49,PSOIENS,3.1,"E"))
- +9 SET ESIG=$GET(ERXDAT(52.49,PSOIENS,7,"E"))
- +10 SET COMM=$GET(ERXDAT(52.49,PSOIENS,8,"E"))
- +11 SET SUBS=$GET(ERXDAT(52.49,PSOIENS,5.8,"E"))
- +12 SET DFORM=$GET(ERXDAT(52.49,PSOIENS,41,"E"))
- +13 SET DSTR=$GET(ERXDAT(52.49,PSOIENS,43,"E"))
- +14 IF 'S2017
- SET QQUAL=$GET(ERXDAT(52.49,PSOIENS,5.2,"E"))
- +15 IF S2017
- Begin DoDot:1
- +16 SET MIEN=$ORDER(^PS(52.49,PSOIEN,311,0))
- +17 SET QQUAL=$$GET1^DIQ(52.49311,MIEN_","_PSOIEN_",",2.2,"I")
- SET QQUAL=$$GET1^DIQ(52.45,QQUAL,.02,"E")
- End DoDot:1
- +18 SET POTUC=$GET(ERXDAT(52.49,PSOIENS,42,"E"))
- +19 SET QTY=$GET(ERXDAT(52.49,PSOIENS,5.1,"E"))
- +20 SET DAYS=$GET(ERXDAT(52.49,PSOIENS,5.5,"E"))
- +21 SET REFILL=$GET(ERXDAT(52.49,PSOIENS,5.6,"E"))
- +22 IF 'S2017
- Begin DoDot:1
- +23 IF REFILL=""
- Begin DoDot:2
- +24 SET REFILL=$GET(ERXDAT(52.49,PSOIENS,5.7,"I"))
- End DoDot:2
- End DoDot:1
- +25 IF MTYPE="RE"
- IF RESVAL="R"
- IF REFILL>0
- SET REFILL=REFILL-1
- +26 DO TXT2ARY^PSOERXD1(.SIGARY,ESIG,,69)
- +27 DO TXT2ARY^PSOERXD1(.COMMARY,COMM,,65)
- +28 WRITE !,"eRx Drug: "_EDRG_" "_$PIECE($$ERXDRSCH^PSOERXUT(PSOIENS),"^",2)
- +29 IF 'S2017
- Begin DoDot:1
- +30 WRITE !,"eRx Sig: "
- +31 SET I=0
- FOR
- SET I=$ORDER(SIGARY(I))
- if 'I
- QUIT
- Begin DoDot:2
- +32 WRITE $SELECT(I>1:" "_SIGARY(I),1:SIGARY(I)),!
- End DoDot:2
- End DoDot:1
- +33 IF '$LENGTH(ESIG)
- WRITE !
- +34 IF S2017
- Begin DoDot:1
- +35 WRITE !,"eRx Sig:"
- +36 SET SGLOOP=0
- FOR
- SET SGLOOP=$ORDER(^PS(52.49,PSOIEN,311,MIEN,8,SGLOOP))
- if 'SGLOOP
- QUIT
- Begin DoDot:2
- +37 WRITE !,$GET(^PS(52.49,PSOIEN,311,MIEN,8,SGLOOP,0))
- End DoDot:2
- End DoDot:1
- +38 WRITE !!,"eRx Notes: "
- +39 SET I=0
- FOR
- SET I=$ORDER(COMMARY(I))
- if 'I
- QUIT
- Begin DoDot:1
- +40 WRITE $SELECT(I>1:" "_COMMARY(I),1:COMMARY(I)),!
- End DoDot:1
- +41 IF '$LENGTH(COMM)
- WRITE !
- +42 if DFLG=1
- QUIT
- +43 WRITE "Drug Form: "_DFORM,?40,"Strength: "_DSTR
- +44 WRITE !,"Code List Qualifier: "_QQUAL,?40,"Quantity Unit of Measure: "_POTUC
- +45 SET ERXDSUB=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")
- +46 SET ERXDSUB=$SELECT(ERXDSUB=1:"NO",ERXDSUB=0:"YES",1:"")
- +47 WRITE !,"Substitutions? :"_ERXDSUB
- +48 WRITE !,"Qty: "_QTY,?25,"Days Supply: "_DAYS,?55,"Refills: "_REFILL,!
- +49 QUIT
- REM ;
- +1 NEW MBMSITE,DIR,Y,PSSRET,PSOIENS,REMIEN,REMSTA,REMTXT,ERXRMIEN,DIC,X,RXSTAT,FDA
- +2 SET MBMSITE=$SELECT($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
- +3 DO FULL^VALM1
- +4 SET PSOIENS=PSOIEN_","
- +5 SET VALMBCK="R"
- +6 SET RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
- IF RXSTAT="RJ"!(RXSTAT="RM")!($GET(MBMSITE)&($EXTRACT(RXSTAT,1,3)="REM"))!(RXSTAT="PR")
- Begin DoDot:1
- +7 WRITE !!,"Cannot remove a prescription with a status of 'Rejected', 'Removed',",!,"or 'Processed",!
- +8 SET DIR(0)="E"
- DO ^DIR
- End DoDot:1
- QUIT
- +9 WRITE !
- SET DIC="^PS(52.45,"
- SET DIC(0)="AEMQ"
- SET DIC("S")="I $D(^PS(52.45,""TYPE"",""REM"",Y))"
- SET DIC("A")="Select REMOVAL reason code: "
- +10 DO ^DIC
- KILL DIC
- +11 IF $PIECE(Y,U)<1
- QUIT
- +12 SET REMIEN=$PIECE(Y,U)
- SET REMSTA=$PIECE(Y,U,2)
- +13 IF +$GET(REMIEN)<1
- WRITE !,"Removal reason code required!"
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- QUIT
- +14 KILL X,Y
- SET DIR(0)="FO^1:70"
- SET DIR("A")="Additional Comments (Optional)"
- DO ^DIR
- KILL DIR
- +15 if Y="^"
- QUIT
- +16 SET REMTXT=$GET(Y)
- +17 WRITE !
- SET DIR(0)="YO"
- SET DIR("A")="Would you like to 'Remove' eRx #"_$$GET1^DIQ(52.49,PSOIEN,.01,"E")
- SET DIR("B")="Y"
- DO ^DIR
- KILL DIR
- +18 if 'Y
- QUIT
- +19 IF '$GET(MBMSITE)
- Begin DoDot:1
- +20 KILL FDA
- SET FDA(52.4919,"+1,"_PSOIENS,.01)=$$NOW^XLFDT
- SET FDA(52.4919,"+1,"_PSOIENS,.02)=REMIEN
- +21 SET FDA(52.4919,"+1,"_PSOIENS,.03)=DUZ
- SET FDA(52.4919,"+1,"_PSOIENS,1)=REMTXT
- +22 DO UPDATE^DIE(,"FDA")
- KILL FDA
- End DoDot:1
- +23 ; SET THE ERX STATUS TO THE REMOVAL REASON
- +24 DO UPDSTAT^PSOERXU1(PSOIEN,$SELECT('$GET(MBMSITE):"RM",1:REMSTA),REMTXT)
- +25 ;allow user to perform a batch removal of eRx for a patient with the same provider if it comes in on the same day
- +26 ; "R"-remove
- DO BATCHREM^PSOERX1H(PSOIEN,REMIEN,REMTXT,"R")
- +27 KILL @VALMAR
- DO REF^PSOERSE1
- +28 QUIT
- +29 ; unremove eRx
- UNREM ;
- +1 NEW DIR,Y,DA,DIE,DR,HCOMM,PSSRET,PSOIENS,REMIEN,REMSTA,REMTXT,ERXRMIEN,DIC,X,RXSTAT,SEQ,NEWSTA
- +2 DO FULL^VALM1
- +3 SET PSOIENS=PSOIEN_","
- +4 SET VALMBCK="R"
- +5 DO CHKSTA
- IF RXSTAT'="RM"
- Begin DoDot:1
- +6 WRITE !!,"Cannot Un-Remove a prescription that the status is not 'Removed'"
- +7 SET DIR(0)="E"
- DO ^DIR
- End DoDot:1
- QUIT
- HLD WRITE !
- +1 SET DIC="^PS(52.45,"
- SET DIC(0)="AEMQ"
- SET DIC("S")="I $E($P(^PS(52.45,+Y,0),U))=""H"""
- SET DIC("B")="HUR"
- +2 SET DIC("A")="Select HOLD reason code: "
- DO ^DIC
- KILL DIC
- +3 ;if user ^
- IF $PIECE(Y,U)<1
- QUIT
- +4 SET REMIEN=$PIECE(Y,U)
- +5 IF +$GET(REMIEN)<0
- WRITE !,"HOLD reason code required!"
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- GOTO HLD
- +6 ; Add comment in 52.4919
- +7 SET DIR(0)="52.4919,1"
- SET DIR("A")="Additional Comments (Optional)"
- DO ^DIR
- KILL DIR
- +8 IF Y="^"
- QUIT
- +9 SET HCOMM=$GET(Y)
- +10 SET DIR(0)="YO"
- SET DIR("A")="Would you like to 'Un-Remove' eRx #"_$$GET1^DIQ(52.49,PSOIEN,.01,"E")
- +11 SET DIR("B")="Y"
- DO ^DIR
- KILL DIR
- +12 if 'Y
- QUIT
- +13 DO UPDSTAT^PSOERXU1(PSOIEN,$$GET1^DIQ(52.45,REMIEN,.01),HCOMM)
- +14 SET DR="1///"_REMIEN
- SET DIE="^PS(52.49,"
- SET DA=PSOIEN
- DO ^DIE
- +15 ; "U" - Un-remove
- DO BATCHREM^PSOERX1H(PSOIEN,REMIEN,HCOMM,"U")
- +16 ;Refresh screen
- KILL @VALMAR
- DO REF^PSOERSE1
- +17 QUIT
- CHKSTA ; check if status is RM or type is "REM"
- +1 SET STAIEN=+$GET(^PS(52.49,PSOIEN,1))
- SET RXSTAT=$PIECE(^PS(52.45,STAIEN,0),"^",1)
- +2 IF RXSTAT="RM"
- KILL STAIEN
- QUIT
- +3 SET RXSTAT=$SELECT($PIECE(^PS(52.45,STAIEN,0),"^",3)="REM":"RM",1:"")
- KILL STAIEN
- +4 QUIT
- +5 ; reject eRx
- REJ ;
- +1 NEW MBMSITE,DIR,DIC,Y,PSSRET,PSOIENS,REMTXT,REJSTA,FULLTXT,ERXRJIEN,REJDESC,REJIEN,REJTXT,X,RXSTAT
- +2 SET MBMSITE=$SELECT($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
- +3 DO FULL^VALM1
- +4 SET PSOIENS=PSOIEN_","
- +5 SET VALMBCK="R"
- +6 SET RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
- IF RXSTAT="RJ"!(RXSTAT="RM")!($GET(MBMSITE)&($EXTRACT(RXSTAT,1,3)="REM"))!(RXSTAT="PR")
- Begin DoDot:1
- +7 WRITE !!,"Cannot reject a prescription with a status of 'Rejected', 'Removed',",!,"or 'Processed",!
- +8 SET DIR(0)="E"
- DO ^DIR
- End DoDot:1
- QUIT
- +9 SET DIR(0)="YO"
- SET DIR("A")="Would you like to 'Reject' eRx #"_$$GET1^DIQ(52.49,PSOIEN,.01,"E")
- SET DIR("B")="Y"
- DO ^DIR
- KILL DIR
- +10 if 'Y
- QUIT
- +11 SET DIC="^PS(52.45,"
- SET DIC(0)="AEMQ"
- SET DIC("S")="I $D(^PS(52.45,""TYPE"",""REJ"",Y))"
- SET DIC("A")="Select REJECT reason code: "
- +12 DO ^DIC
- KILL DIC
- +13 IF $PIECE(Y,U)<1
- WRITE !,"Reject reason required! eRx NOT rejected."
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- QUIT
- +14 SET REJIEN=$PIECE(Y,U)
- SET REJSTA=$PIECE(Y,U,2)
- +15 KILL X,Y,DIR
- +16 SET DIR(0)="FO^1:200"
- SET DIR("A")="Additional Comments (Optional)"
- DO ^DIR
- KILL DIR
- +17 if Y="^"
- QUIT
- +18 ; if reject reason was entered, log the activity.
- +19 SET REJTXT=Y
- +20 SET REJDESC=$$GET1^DIQ(52.45,REJIEN,.02,"E")
- +21 SET FULLTXT=REJSTA_" "_REJDESC_" - Additional Comments: "_REJTXT
- +22 DO POST^PSOERXO1(PSOIEN,.PSSRET,900,"",$EXTRACT(FULLTXT,1,295))
- +23 ; if the post was unsuccessful, inform the user and quit.
- +24 IF $PIECE(PSSRET(0),U)<1
- WRITE !,$PIECE(PSSRET(0),U,2)
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- QUIT
- +25 IF $DATA(PSSRET("errorMessage"))
- WRITE !,PSSRET("errorMessage")
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- QUIT
- +26 WRITE !!,"Rejection message sent."
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +27 ; if post is successful, change the eRx status and log the status activity.
- +28 SET FDA(52.4919,"+1,"_PSOIENS,.01)=$$NOW^XLFDT
- +29 SET FDA(52.4919,"+1,"_PSOIENS,.02)=REJIEN
- +30 SET FDA(52.4919,"+1,"_PSOIENS,.03)=DUZ
- +31 SET FDA(52.4919,"+1,"_PSOIENS,1)=REJTXT
- +32 DO UPDATE^DIE(,"FDA")
- KILL FDA
- +33 ; SET THE ERX STATUS TO THE REJECT REASON
- +34 DO UPDSTAT^PSOERXU1(PSOIEN,"RJ")
- +35 QUIT
- QTYDSRFL(ERXIEN,EDTYP) ;
- +1 ; ERXIEN - ien from 52.49
- +2 ; EDTYP:
- +3 ; 1 - DAYS SUPPLY
- +4 ; 2 - QUANTITY
- +5 ; 3 - REFILLS
- +6 ; 4 - SCHEDULE/DOSAGE EDIT
- +7 NEW PSODRUG,PSODIR,ERXDRUG,PSODFN,ERXIENS,FDA,CLOZPAT,PSOY,PATSTAT,Y,DONE,DIR,ANS,NWDAYSUP,NEWQTY,PSODRG,PSONEW,PQUIT
- +8 SET ERXIENS=ERXIEN_","
- +9 ; setup drug array
- +10 SET ERXDRUG=$$GET1^DIQ(52.49,ERXIEN,3.2,"I")
- if 'ERXDRUG
- QUIT 0
- +11 SET PSOY=ERXDRUG
- SET PSOY(0)=$GET(^PSDRUG(ERXDRUG,0))
- +12 DO SET^PSODRG
- +13 SET PSODRG=ERXDRUG
- +14 ; set quanity, days supply, refill, and patient information
- +15 SET PSODFN=$$GET1^DIQ(52.49,ERXIEN,.05,"I")
- +16 SET PSODIR("QTY")=$$GET1^DIQ(52.49,ERXIEN,20.1,"E")
- +17 SET PSODIR("DAYS SUPPLY")=$$GET1^DIQ(52.49,ERXIEN,20.2,"E")
- +18 SET PSODIR("# OF REFILLS")=$$GET1^DIQ(52.49,ERXIEN,20.5,"E")
- +19 ; Decrement # of refills if this is a RxRenewalResponse with a response type of 'Replace'
- +20 ; only decrement if field 20.5 and 5.6 are the same.
- +21 IF PSODIR("# OF REFILLS")>0
- IF $$GET1^DIQ(52.49,ERXIEN,.08,"I")="RE"
- IF $$GET1^DIQ(52.49,ERXIEN,52.1,"I")="R"
- Begin DoDot:1
- +22 IF PSODIR("# OF REFILLS")=$$GET1^DIQ(52.49,ERXIEN,5.6,"E")
- Begin DoDot:2
- +23 SET PSODIR("# OF REFILLS")=$GET(PSODIR("# OF REFILLS"))-1
- End DoDot:2
- End DoDot:1
- +24 SET PSODIR("DFLG")=0
- +25 SET PATSTAT=$$GET1^DIQ(55,PSODFN,3,"E")
- +26 IF '$LENGTH(PATSTAT)
- Begin DoDot:1
- +27 SET DONE=0
- +28 FOR
- Begin DoDot:2
- +29 WRITE !,"This is a required response. Enter '^' to exit"
- +30 KILL DA
- SET DIR(0)="55,3"
- SET DIR("A")="PATIENT STATUS"
- DO ^DIR
- KILL DIR
- +31 IF +Y
- SET DONE=1
- QUIT
- +32 IF Y["^"
- SET PQUIT=1
- SET DONE=1
- QUIT
- End DoDot:2
- if DONE
- QUIT
- +33 SET ANS=$PIECE(Y,"^",1)
- +34 SET FDA(55,PSODFN_",",3)=ANS
- +35 DO FILE^DIE(,"FDA","ERR")
- KILL FDA,ERR
- End DoDot:1
- +36 SET PSODIR("PATIENT STATUS")=$PIECE($GET(^PS(55,PSODFN,"PS")),U)
- +37 SET X=$GET(PSODIR("PATIENT STATUS"))
- +38 IF X
- Begin DoDot:1
- +39 SET DIC=53
- SET DIC(0)="QXZ"
- DO ^DIC
- KILL DIC
- +40 if +Y>0
- SET PSODIR("PTST NODE")=Y(0)
- End DoDot:1
- +41 IF $PIECE($GET(^PSDRUG(PSODRG,"CLOZ1")),"^")="PSOCLO1"
- Begin DoDot:1
- +42 SET CLOZPAT=$ORDER(^YSCL(603.01,"C",PSODFN,0))
- if 'CLOZPAT
- QUIT
- +43 SET CLOZPAT=$PIECE(^YSCL(603.01,CLOZPAT,0),"^",3)
- +44 SET CLOZPAT=$SELECT(CLOZPAT="M":2,CLOZPAT="B":1,1:0)
- End DoDot:1
- +45 IF EDTYP=1
- Begin DoDot:1
- +46 if '$GET(PSODIR("DAYS SUPPLY"))
- SET NWDAYSUP=$$DAYSCHK(.PSODRUG,.PSODIR)
- +47 IF $GET(NWDAYSUP)
- SET PSODIR("DAYS SUPPLY")=NWDAYSUP
- +48 DO DAYS^PSODIR1(.PSODIR)
- DO FILE
- +49 KILL QTYDSRFL
- End DoDot:1
- +50 IF EDTYP=2
- SET PSONEW("FLD")=7
- Begin DoDot:1
- +51 IF $$GET1^DIQ(52.49,PSOIEN,20.1)'=""
- Begin DoDot:2
- +52 SET PSODIR("QTY")=$$GET1^DIQ(52.49,PSOIEN,20.1)
- End DoDot:2
- +53 IF '$TEST
- SET NEWQTY=$$QTYCHECK
- SET PSODIR("QTY")=NEWQTY
- +54 DO QTY^PSODIR1(.PSODIR)
- DO FILE
- +55 KILL QTYARY
- End DoDot:1
- +56 IF EDTYP=3
- SET PSONEW("FLD")=9
- DO REFILL^PSODIR1(.PSODIR)
- +57 IF $GET(PSODIR("DFLG"))=1
- QUIT 1
- +58 SET QTYDSRFL("QTY")=$GET(PSODIR("QTY"))
- +59 DO FILE
- +60 QUIT 0
- FILE ;
- +1 NEW NEWVAL
- +2 SET FDA(52.49,ERXIENS,20.1)=$GET(PSODIR("QTY"))
- +3 SET FDA(52.49,ERXIENS,20.2)=$GET(PSODIR("DAYS SUPPLY"))
- +4 SET FDA(52.49,ERXIENS,20.5)=$GET(PSODIR("# OF REFILLS"))
- +5 DO FILE^DIE(,"FDA")
- KILL FDA
- +6 ;Saving the eRx Audit Log for QTY, DAYS SUPPLY & # OF REFILLS
- +7 IF $GET(PSODIR("QTY"))'=""
- SET NEWVAL(1)=$GET(PSODIR("QTY"))
- DO AUDLOG^PSOERXUT(+PSOIEN,"QTY",DUZ,.NEWVAL)
- +8 IF $GET(PSODIR("DAYS SUPPLY"))'=""
- SET NEWVAL(1)=$GET(PSODIR("DAYS SUPPLY"))
- DO AUDLOG^PSOERXUT(+PSOIEN,"DAYS SUPPLY",DUZ,.NEWVAL)
- +9 IF $GET(PSODIR("# OF REFILLS"))'=""
- SET NEWVAL(1)=$GET(PSODIR("# OF REFILLS"))
- DO AUDLOG^PSOERXUT(+PSOIEN,"# OF REFILLS",DUZ,.NEWVAL)
- +10 QUIT
- DAYSCHK(PSODRUG,PSODIR) ; auto calculate days supply based off quantity.
- +1 NEW QTYDSRFL,DAYSUP,I,ADUR,IENS
- +2 NEW QTYDSRFL,VAL,DOSE
- +3 FOR DOSE=1:1
- if '$DATA(^PS(52.49,PSOIEN,21,DOSE))
- QUIT
- Begin DoDot:1
- +4 SET QTYDSRFL("DOSE ORDERED",DOSE)=$$GET1^DIQ(52.4921,DOSE_","_PSOIEN_",",9,"E")_"^"
- +5 SET QTYDSRFL("SCHEDULE",DOSE)=$$GET1^DIQ(52.4921,DOSE_","_PSOIEN_",",1,"E")
- +6 SET QTYDSRFL("DURATION",DOSE)=$$GET1^DIQ(52.4921,DOSE_","_PSOIEN_",",2,"E")
- +7 SET QTYDSRFL("CONJUNCTION",DOSE)=$$GET1^DIQ(52.4921,DOSE_","_PSOIEN_",",6,"E")
- End DoDot:1
- +8 IF '$GET(QTYDSRFL("DOSE ORDERED",1))
- QUIT 0
- +9 SET QTYDSRFL("PATIENT")=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
- +10 SET QTYDSRFL("DRUG")=$GET(PSODRUG("IEN"))
- +11 SET QTYDSRFL("QTY")=$GET(PSODIR("QTY"))
- +12 DO QTYX^PSOSIG(.QTYDSRFL)
- +13 SET DAYSUP=$GET(QTYDSRFL("DAYS SUPPLY"))
- +14 QUIT DAYSUP
- +15 ;
- QTYCHECK(PSODRUG,PSODIR) ; return qty for days supply
- +1 ; VAL: quantity
- +2 NEW QTYARY,VAL,DOSE
- +3 FOR DOSE=1:1
- if '$DATA(^PS(52.49,PSOIEN,21,DOSE))
- QUIT
- Begin DoDot:1
- +4 SET QTYARY("DOSE ORDERED",DOSE)=$$GET1^DIQ(52.4921,DOSE_","_PSOIEN_",",9,"E")_"^"
- +5 SET QTYARY("SCHEDULE",DOSE)=$$GET1^DIQ(52.4921,DOSE_","_PSOIEN_",",1,"E")
- +6 SET QTYARY("DURATION",DOSE)=$$GET1^DIQ(52.4921,DOSE_","_PSOIEN_",",2,"E")
- +7 SET QTYARY("CONJUNCTION",DOSE)=$$GET1^DIQ(52.4921,DOSE_","_PSOIEN_",",6,"E")
- End DoDot:1
- +8 IF '$GET(QTYARY("DOSE ORDERED",1))
- QUIT ""
- +9 SET QTYARY("PATIENT")=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
- +10 SET QTYARY("DRUG")=$GET(PSODRUG("IEN"))
- +11 SET QTYARY("DAYS SUPPLY")=$$GET1^DIQ(52.49,PSOIEN,20.2,"E")
- +12 DO QTYX^PSOSIG(.QTYARY)
- +13 SET VAL=$GET(QTYARY("QTY"))
- +14 QUIT VAL