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

PSOERXU4.m

Go to the documentation of this file.
PSOERXU4 ;ALB/BLB - eRx utilities ; 3/18/2021 14:03pm
 ;;7.0;OUTPATIENT PHARMACY;**520,508,551,581,635**;DEC 1997;Build 19
 ;
 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
 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 DIR,Y,PSSRET,PSOIENS,REMIEN,REMSTA,REMTXT,ERXRMIEN,DIC,X,RXSTAT
 D FULL^VALM1
 S PSOIENS=PSOIEN_","
 S VALMBCK="R"
 S RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E") I RXSTAT="RJ"!(RXSTAT="RM")!(RXSTAT="PR") D  Q
 .W !!,"Cannot remove 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 'Remove' 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"",""REM"",Y))",DIC("A")="Select REMOVAL reason code: "
 D ^DIC K DIC
 I $P(Y,U)<1 W !,"Removal reason code required!" S DIR(0)="E" D ^DIR K DIR Q
 S REMIEN=$P(Y,U),REMSTA=$P(Y,U,2)
 K X,Y S DIR(0)="FO^1:70",DIR("A")="Additional Comments (Optional)" D ^DIR K DIR
 Q:Y="^"
 S REMTXT=Y
 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,"RM")
 Q
 ; reject eRx
REJ ;
 N DIR,DIC,Y,PSSRET,PSOIENS,REMTXT,REJSTA,FULLTXT,ERXRJIEN,REJDESC,REJIEN,REJTXT,X,RXSTAT
 D FULL^VALM1
 S PSOIENS=PSOIEN_","
 S VALMBCK="R"
 S RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E") I RXSTAT="RJ"!(RXSTAT="RM")!(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
 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")
 ; PSO*7*635, 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("PATIENT STATUS")=$P(^PS(55,PSODFN,"PS"),U)
 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"
 ..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(^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 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 S NWDAYSUP=$$DAYSCHK(.PSODRUG,.PSODIR) D
 .I $G(NWDAYSUP) S PSODIR("DAYS SUPPLY")=NWDAYSUP
 .I PSODIR("DAYS SUPPLY")>$P($G(PSODIR("PTST NODE")),"^",3) S PSODIR("DAYS SUPPLY")=$P($G(PSODIR("PTST NODE")),"^",3)
 .D DAYS^PSODIR1(.PSODIR) D FILE
 .K QTYDSRFL
 I EDTYP=2 S PSONEW("FLD")=7 D
 .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 ;
 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
 Q
DAYSCHK(PSODRUG,PSODIR) ; auto calculate days supply based off quantity.
 N QTYDSRFL,DAYSUP,I,ADUR,IENS
 S IENS=1_","_PSOIEN_","
 S QTYDSRFL("SCHEDULE")=$$GET1^DIQ(52.4921,IENS,1,"E")
 S QTYDSRFL("DOSE ORDERED")=$$GET1^DIQ(52.4921,IENS,9,"E")_"^"
 I 'QTYDSRFL("DOSE ORDERED") Q 0
 S QTYDSRFL("DURATION")=$$GET1^DIQ(52.4921,IENS,2,"E")
 S QTYDSRFL("PATIENT")=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
 S QTYDSRFL("DRUG")=$G(PSODRUG("IEN"))
 S QTYDSRFL("QTY")=$G(PSODIR("QTY"))
 F I=1:1:$L(QTYDSRFL("DOSE ORDERED"),U)-1 D
 .S QTYDSRFL("DOSE ORDERED",I)=$P(QTYDSRFL("DOSE ORDERED"),U,I)
 .S QTYDSRFL("SCHEDULE",I)=$P(QTYDSRFL("SCHEDULE"),U,I)
 .S ADUR=$P(QTYDSRFL("DURATION"),U,I),X=+ADUR_$E($P(ADUR," ",2))
 .I $L(X) S QTYDSRFL("DURATION",I)=X
 .S X=$E($P(ADUR,"~",2))
 .I $L(X) S QTYDSRFL("CONJUNCTION",I)=X
 D QTYX^PSOSIG(.QTYDSRFL)
 S DAYSUP=$G(QTYDSRFL("DAYS SUPPLY"))
 Q DAYSUP
QTYCHECK(PSODRUG,PSODIR) ; return qty for days supply
 ; VAL: quantity
 N QTYARY,I,X,ADUR,ADURNM,IENS,VAL
 S IENS=1_","_PSOIEN_","
 S QTYARY("DOSE ORDERED")=$$GET1^DIQ(52.4921,IENS,9,"E")_"^"
 S QTYARY("DURATION")=$$GET1^DIQ(52.4921,IENS,2,"E")
 S QTYARY("SCHEDULE")=$$GET1^DIQ(52.4921,IENS,1,"E")
 S QTYARY("DAYS SUPPLY")=$$GET1^DIQ(52.49,ERXIEN,20.2,"E")
 S QTYARY("PATIENT")=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
 ;I $G(DRG) S QTYARY("DRUG")=DRG
 S QTYARY("DRUG")=$G(PSODRUG("IEN"))
 F I=1:1:$L(QTYARY("DOSE ORDERED"),U)-1 D
 . S QTYARY("DOSE ORDERED",I)=$P(QTYARY("DOSE ORDERED"),U,I)_"^"
 . S QTYARY("SCHEDULE",I)=$P(QTYARY("SCHEDULE"),U,I)
 . S ADUR=$P(QTYARY("DURATION"),U,I),ADURNM=$P($P(ADUR," ",2),"~")
 . S:ADURNM="MONTHS" X=+ADUR_"L"
 . S:ADURNM'="MONTHS" X=+ADUR_$E($P(ADUR," ",2))
 . I $L(X) S QTYARY("DURATION",I)=X
 . S X=$E($P(ADUR,"~",2))
 . I $L(X) S QTYARY("CONJUNCTION",I)=X
 D QTYX^PSOSIG(.QTYARY)
 S VAL=$G(QTYARY("QTY"))
 Q VAL