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

PSOERXH1.m

Go to the documentation of this file.
  1. PSOERXH1 ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
  1. ;;7.0;OUTPATIENT PHARMACY;**467,527,508,581,617,700,746,769**;DEC 1997;Build 26
  1. ;
  1. Q
  1. ; place eRx on Hold
  1. HOLD ;
  1. N MBMSITE,DIE,DA,DR,CURSTAT,CSTATI,LMATCH,LSTAT,SUBFIEN,NEWSTAT,RESP,DIR,RXSTAT,HCOMM,MTYPE,HFFDT
  1. S MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
  1. Q:'$G(PSOIEN)
  1. D FULL^VALM1 S VALMBCK="R"
  1. I $$DONOTFIL^PSOERXUT(PSOIEN) Q
  1. S MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
  1. S RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
  1. I RXSTAT="RJ"!(RXSTAT="RM")!($G(MBMSITE)&($E(RXSTAT,1,3)="REM"))!(RXSTAT="PR") D Q
  1. . W !!,"Cannot hold a prescription with a status of 'Rejected', 'Removed',",!,"or 'Processed",!
  1. . S DIR(0)="E" D ^DIR
  1. I RXSTAT="RXP"!(RXSTAT="RXC")!(RXSTAT="RXE") D Q
  1. . W !!,"Cannot hold a renewal response record that is in 'Complete', 'Processed', or 'Error' status.",!
  1. ; check to see if the erx order status is a hold status
  1. S CSTATI=$$GET1^DIQ(52.49,PSOIEN,1,"I")
  1. S CURSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
  1. S VALMBCK="R" W !
  1. I $E(CURSTAT,1)="H" D Q
  1. . S DIR(0)="YO",DIR("B")="NO"
  1. . S DIR("A",1)="This eRx is already in a 'HOLD' status."
  1. . S DIR("A")="Would you like to change the hold status and comments?"
  1. . D ^DIR
  1. . Q:'Y
  1. . K DIR
  1. . S RESP=$$HDIR(1)
  1. . I 'RESP D Q
  1. . . W !!,"Hold Reason required. eRx not placed in a 'Hold' status."
  1. . . K DIR,DA S DIR(0)="E" D ^DIR
  1. . K DIR,DA S DIR(0)="52.4919,1",DIR("A")="Additional Comments (Optional)" D ^DIR
  1. . I Y="^" W !,"eRx NOT placed on hold." K DIR S DIR(0)="E" D ^DIR Q
  1. . S HCOMM=$G(Y)
  1. . S DIE="52.49",DA=PSOIEN,DR="1///"_RESP D ^DIE K DIE
  1. . S SUBFIEN=$$NSTAT(PSOIEN,RESP,HCOMM)
  1. . K @VALMAR D REF^PSOERSE1 ;Refresh screen
  1. . S PSORFRSH=1
  1. K Y
  1. S RESP=$$HDIR(),HFFDT=""
  1. I 'RESP D Q
  1. . W !!,"Hold Reason required. eRx not placed in a 'Hold' status."
  1. . S DIR(0)="E" D ^DIR
  1. I $D(^PS(52.45,"B","HFF",RESP)) D I $D(DIRUT)!$D(DIROUT) W !,"eRx NOT placed on hold." K DIR S DIR(0)="E" D ^DIR Q
  1. . W !!,$G(IOINHI),"The eRx will be un-held automatically on the date you enter below and placed"
  1. . W !,"in '",$$GET1^DIQ(52.45,$$GET1^DIQ(52.49,PSOIEN,1,"I"),.02),"' status.",$G(IOINORM)
  1. . K DIR W ! S DIR(0)="DA^"_$$FMADD^XLFDT(DT,1)_":"_$S($$GET1^DIQ(52.49,PSOIEN,95.1,"I"):$$FMADD^XLFDT(DT,185),1:$$FMADD^XLFDT(DT,364))_":EX"
  1. . I $$EFFDATE^PSOERXU5(PSOIEN,1)'="" S DIR("B")=$$FMTE^XLFDT($$EFFDATE^PSOERXU5(PSOIEN,1))
  1. . S DIR("A")="Future Fill Hold Date: " D ^DIR I $D(DIRUT)!$D(DIROUT) Q
  1. . S HFFDT=Y
  1. W ! K DIR,DA S DIR(0)="52.4919,1",DIR("A")="Additional Comments (Optional)" D ^DIR K DIR
  1. I Y="^" Q
  1. S HCOMM=Y
  1. W !,"Updating..."
  1. I $G(HFFDT) K DIE S DIE="52.49",DA=PSOIEN,DR="6.7///"_HFFDT D ^DIE K DIE
  1. D UPDSTAT^PSOERXU1(PSOIEN,$$GET1^DIQ(52.45,RESP,.01),HCOMM,,,$G(HFFDT))
  1. H .5 W "done.",$C(7) H 1
  1. S PSORFRSH=1
  1. ; Batch Hold (Not an option for Future Fill Hold (HFF))
  1. I '$D(^PS(52.45,"B","HFF",RESP)) D BATCHHLD^PSOERXH2(PSOIEN,RESP,HCOMM,"H")
  1. D REF^PSOERSE1
  1. Q
  1. NSTAT(IEN,STAT,COMM) ;
  1. N SUBFIEN
  1. S FDA(52.4919,"+1,"_IEN_",",.01)=$$NOW^XLFDT()
  1. S FDA(52.4919,"+1,"_IEN_",",.02)=STAT
  1. S FDA(52.4919,"+1,"_IEN_",",.03)=$G(DUZ)
  1. S FDA(52.4919,"+1,"_IEN_",",1)=COMM
  1. D UPDATE^DIE(,"FDA","NEWSTAT") K FDA
  1. S SUBFIEN=$O(NEWSTAT(0)) Q:'SUBFIEN
  1. S SUBFIEN=$G(NEWSTAT(SUBFIEN))
  1. Q SUBFIEN
  1. HDIR(HTYP) ;
  1. N DIC,Y,X
  1. S DIC("A")="Select HOLD reason code: "
  1. S DIC="^PS(52.45,",DIC(0)="AEMQ",DIC("S")="I $D(^PS(52.45,""TYPE"",""ERX"",Y)),$E($P(^PS(52.45,Y,0),U),1)=""H"""
  1. D ^DIC K DIC
  1. I Y<1 Q 0
  1. Q:'+$P(Y,U) 0
  1. Q $P(Y,U)
  1. ; remove hold from eRx
  1. UNHOLD ;
  1. N Y,DIR,DIE,DA,DR,NEWSIEN,RXSTAT,HFFHOLD,RXSTATI,MTYPE,QUIT,PEND,HOLDIEN
  1. D FULL^VALM1 S VALMBCK="R"
  1. I $$DONOTFIL^PSOERXUT(PSOIEN) Q
  1. S MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
  1. S PEND=$$GET1^DIQ(52.49,PSOIEN,25.2,"I")
  1. S RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E") S HFFHOLD=0 I RXSTAT="HFF" S HFFHOLD=1
  1. I RXSTAT="RJ"!(RXSTAT="RM")!($G(MBMSITE)&($E(RXSTAT,1,3)="REM"))!(RXSTAT="PR") D Q
  1. . W !!,"Cannot un-hold a prescription with a status of 'Rejected', 'Removed',",!,"or 'Processed",!
  1. . S DIR(0)="E" D ^DIR
  1. W !
  1. I $E($$GET1^DIQ(52.49,PSOIEN,1,"E"),1)'="H" D Q
  1. .W !,"This eRx is not currently on hold. Please use the 'Hold'",!,"function to update the hold status and comments.",!!
  1. .K DIR,DA S DIR(0)="E"
  1. .D ^DIR
  1. .K @VALMAR D REF^PSOERSE1
  1. ; Un-Hold Comments
  1. S DIR(0)="52.4919,1",DIR("A")="Additional Comments (Optional)" D ^DIR K DIR
  1. I Y="^" Q
  1. S UHCOMM=$G(Y)
  1. S HOLDIEN=$$GET1^DIQ(52.49,PSOIEN,1,"I")
  1. ;
  1. I RXSTAT="HC" D
  1. .W !,"A change request has been generated for this NewRx record.",!,"Are you sure you like to unhold this prescription?"
  1. .K DIR S DIR(0)="Y",DIR("B")="Y" D ^DIR
  1. .I Y<1 S QUIT=1
  1. I $G(QUIT) Q
  1. ; return processed records to PR - processed, so they cannot be finished again.
  1. I PEND,RXSTAT="HC" D Q
  1. .I PEND D
  1. ..S RXSTATI=$$PRESOLV^PSOERXA1("PR","ERX")
  1. ..D UPDSTAT^PSOERXU1(PSOIEN,"PR",UHCOMM)
  1. .I 'PEND D
  1. ..N LSFOUND,LSLOOP,STDAT,LSTAT,LKNOWN,LKNOWNE
  1. ..S LSFOUND=0
  1. ..I '$D(^PS(52.49,PSOIEN,19)) D
  1. ...I MTYPE="N" S LKNOWNE="I"
  1. ...I MTYPE="RE" S LKNOWNE="RXI"
  1. ...I MTYPE="CX" S LKNOWNE="CXI"
  1. ..S LSLOOP=99999 F S LSLOOP=$O(^PS(52.49,PSOIEN,19,LSLOOP),-1) Q:'LSLOOP!(LSFOUND) D
  1. ...S STDAT=$G(^PS(52.49,PSOIEN,19,LSLOOP,0))
  1. ...S LSTAT=$P(STDAT,U,2)
  1. ...I $$GET1^DIQ(52.45,LSTAT,.01,"E")="HC" D S LSFOUND=1
  1. ....S LKNOWN=$O(^PS(52.49,PSOIEN,19,LSLOOP),-1)
  1. ....S LKNOWNE=$$GET1^DIQ(52.4919,LKNOWN_","_PSOIEN_",",.02,"E")
  1. ...I LKNOWNE="N"!(LKNOWNE="") S LKNOWNE="I"
  1. ..S RXSTATI=$$PRESOLV^PSOERXA1(LKNOWNE,"ERX")
  1. ..D UPDSTAT^PSOERXU1(PSOIEN,LKNOWNE,UHCOMM)
  1. .W !,"eRx removed from hold status, and moved to '"_$$SENTENCE^XLFSTR($$GET1^DIQ(52.45,RXSTATI,.02,"E"))_"'."
  1. .K DIR S DIR(0)="E" D ^DIR K DIR
  1. .K @VALMAR D REF^PSOERSE1
  1. S RXSTAT=$$UHSTS(PSOIEN),RXSTATI=$$PRESOLV^PSOERXA1(RXSTAT,"ERX")
  1. I $G(HFFHOLD) K DIE S DIE="52.49",DA=PSOIEN,DR="6.7///@" D ^DIE K DIE
  1. D UPDSTAT^PSOERXU1(PSOIEN,RXSTAT,UHCOMM)
  1. W !,"eRx removed from hold status, and moved to '"_$$SENTENCE^XLFSTR($$GET1^DIQ(52.45,RXSTATI,.02,"E"))_"'."
  1. K DIR S DIR(0)="E" D ^DIR K DIR
  1. ;Batch Un-Hold (Not an option for Future Fill Hold (HFF))
  1. I '$G(HFFHOLD) D BATCHHLD^PSOERXH2(PSOIEN,HOLDIEN,UHCOMM,"U")
  1. K @VALMAR D REF^PSOERSE1
  1. Q
  1. ;
  1. UHSTS(ERXIEN) ; Returns the eRx status after it's un-held
  1. ; Input: ERXIEN - Pointer to the eRx being worked on (Pointer to #52.49)
  1. ;Output: UHSTS - Status after eRx is un-held
  1. ;
  1. N UHSTS,MTYPE,STSIEN
  1. S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
  1. I $$GET1^DIQ(52.49,ERXIEN,1.3,"I"),$$GET1^DIQ(52.49,ERXIEN,1.5,"I"),$$GET1^DIQ(52.49,ERXIEN,1.7,"I") D
  1. . S STSIEN=$$PRESOLV^PSOERXA1($S(MTYPE="N":"W",MTYPE="RE":"RXW",MTYPE="CX":"CXW",1:""),"ERX") I 'STSIEN Q
  1. . S UHSTS=$$GET1^DIQ(52.45,STSIEN,.01,"E")
  1. I '$G(STSIEN) D
  1. . S STSIEN=$$PRESOLV^PSOERXA1($S(MTYPE="N":"I",MTYPE="RE":"RXI",MTYPE="CX":"CXI",1:""),"ERX") I 'STSIEN Q
  1. . S UHSTS=$$GET1^DIQ(52.45,STSIEN,.01,"E")
  1. Q $G(UHSTS,"I")