PSOERXH1 ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
;;7.0;OUTPATIENT PHARMACY;**467,527,508,581,617,700,746,769**;DEC 1997;Build 26
;
Q
; place eRx on Hold
HOLD ;
N MBMSITE,DIE,DA,DR,CURSTAT,CSTATI,LMATCH,LSTAT,SUBFIEN,NEWSTAT,RESP,DIR,RXSTAT,HCOMM,MTYPE,HFFDT
S MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
Q:'$G(PSOIEN)
D FULL^VALM1 S VALMBCK="R"
I $$DONOTFIL^PSOERXUT(PSOIEN) Q
S MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
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 hold a prescription with a status of 'Rejected', 'Removed',",!,"or 'Processed",!
. S DIR(0)="E" D ^DIR
I RXSTAT="RXP"!(RXSTAT="RXC")!(RXSTAT="RXE") D Q
. W !!,"Cannot hold a renewal response record that is in 'Complete', 'Processed', or 'Error' status.",!
; check to see if the erx order status is a hold status
S CSTATI=$$GET1^DIQ(52.49,PSOIEN,1,"I")
S CURSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
S VALMBCK="R" W !
I $E(CURSTAT,1)="H" D Q
. S DIR(0)="YO",DIR("B")="NO"
. S DIR("A",1)="This eRx is already in a 'HOLD' status."
. S DIR("A")="Would you like to change the hold status and comments?"
. D ^DIR
. Q:'Y
. K DIR
. S RESP=$$HDIR(1)
. I 'RESP D Q
. . W !!,"Hold Reason required. eRx not placed in a 'Hold' status."
. . K DIR,DA S DIR(0)="E" D ^DIR
. K DIR,DA S DIR(0)="52.4919,1",DIR("A")="Additional Comments (Optional)" D ^DIR
. I Y="^" W !,"eRx NOT placed on hold." K DIR S DIR(0)="E" D ^DIR Q
. S HCOMM=$G(Y)
. S DIE="52.49",DA=PSOIEN,DR="1///"_RESP D ^DIE K DIE
. S SUBFIEN=$$NSTAT(PSOIEN,RESP,HCOMM)
. K @VALMAR D REF^PSOERSE1 ;Refresh screen
. S PSORFRSH=1
K Y
S RESP=$$HDIR(),HFFDT=""
I 'RESP D Q
. W !!,"Hold Reason required. eRx not placed in a 'Hold' status."
. S DIR(0)="E" D ^DIR
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
. W !!,$G(IOINHI),"The eRx will be un-held automatically on the date you enter below and placed"
. W !,"in '",$$GET1^DIQ(52.45,$$GET1^DIQ(52.49,PSOIEN,1,"I"),.02),"' status.",$G(IOINORM)
. 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"
. I $$EFFDATE^PSOERXU5(PSOIEN,1)'="" S DIR("B")=$$FMTE^XLFDT($$EFFDATE^PSOERXU5(PSOIEN,1))
. S DIR("A")="Future Fill Hold Date: " D ^DIR I $D(DIRUT)!$D(DIROUT) Q
. S HFFDT=Y
W ! K DIR,DA S DIR(0)="52.4919,1",DIR("A")="Additional Comments (Optional)" D ^DIR K DIR
I Y="^" Q
S HCOMM=Y
W !,"Updating..."
I $G(HFFDT) K DIE S DIE="52.49",DA=PSOIEN,DR="6.7///"_HFFDT D ^DIE K DIE
D UPDSTAT^PSOERXU1(PSOIEN,$$GET1^DIQ(52.45,RESP,.01),HCOMM,,,$G(HFFDT))
H .5 W "done.",$C(7) H 1
S PSORFRSH=1
; Batch Hold (Not an option for Future Fill Hold (HFF))
I '$D(^PS(52.45,"B","HFF",RESP)) D BATCHHLD^PSOERXH2(PSOIEN,RESP,HCOMM,"H")
D REF^PSOERSE1
Q
NSTAT(IEN,STAT,COMM) ;
N SUBFIEN
S FDA(52.4919,"+1,"_IEN_",",.01)=$$NOW^XLFDT()
S FDA(52.4919,"+1,"_IEN_",",.02)=STAT
S FDA(52.4919,"+1,"_IEN_",",.03)=$G(DUZ)
S FDA(52.4919,"+1,"_IEN_",",1)=COMM
D UPDATE^DIE(,"FDA","NEWSTAT") K FDA
S SUBFIEN=$O(NEWSTAT(0)) Q:'SUBFIEN
S SUBFIEN=$G(NEWSTAT(SUBFIEN))
Q SUBFIEN
HDIR(HTYP) ;
N DIC,Y,X
S DIC("A")="Select HOLD reason code: "
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"""
D ^DIC K DIC
I Y<1 Q 0
Q:'+$P(Y,U) 0
Q $P(Y,U)
; remove hold from eRx
UNHOLD ;
N Y,DIR,DIE,DA,DR,NEWSIEN,RXSTAT,HFFHOLD,RXSTATI,MTYPE,QUIT,PEND,HOLDIEN
D FULL^VALM1 S VALMBCK="R"
I $$DONOTFIL^PSOERXUT(PSOIEN) Q
S MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
S PEND=$$GET1^DIQ(52.49,PSOIEN,25.2,"I")
S RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E") S HFFHOLD=0 I RXSTAT="HFF" S HFFHOLD=1
I RXSTAT="RJ"!(RXSTAT="RM")!($G(MBMSITE)&($E(RXSTAT,1,3)="REM"))!(RXSTAT="PR") D Q
. W !!,"Cannot un-hold a prescription with a status of 'Rejected', 'Removed',",!,"or 'Processed",!
. S DIR(0)="E" D ^DIR
W !
I $E($$GET1^DIQ(52.49,PSOIEN,1,"E"),1)'="H" D Q
.W !,"This eRx is not currently on hold. Please use the 'Hold'",!,"function to update the hold status and comments.",!!
.K DIR,DA S DIR(0)="E"
.D ^DIR
.K @VALMAR D REF^PSOERSE1
; Un-Hold Comments
S DIR(0)="52.4919,1",DIR("A")="Additional Comments (Optional)" D ^DIR K DIR
I Y="^" Q
S UHCOMM=$G(Y)
S HOLDIEN=$$GET1^DIQ(52.49,PSOIEN,1,"I")
;
I RXSTAT="HC" D
.W !,"A change request has been generated for this NewRx record.",!,"Are you sure you like to unhold this prescription?"
.K DIR S DIR(0)="Y",DIR("B")="Y" D ^DIR
.I Y<1 S QUIT=1
I $G(QUIT) Q
; return processed records to PR - processed, so they cannot be finished again.
I PEND,RXSTAT="HC" D Q
.I PEND D
..S RXSTATI=$$PRESOLV^PSOERXA1("PR","ERX")
..D UPDSTAT^PSOERXU1(PSOIEN,"PR",UHCOMM)
.I 'PEND D
..N LSFOUND,LSLOOP,STDAT,LSTAT,LKNOWN,LKNOWNE
..S LSFOUND=0
..I '$D(^PS(52.49,PSOIEN,19)) D
...I MTYPE="N" S LKNOWNE="I"
...I MTYPE="RE" S LKNOWNE="RXI"
...I MTYPE="CX" S LKNOWNE="CXI"
..S LSLOOP=99999 F S LSLOOP=$O(^PS(52.49,PSOIEN,19,LSLOOP),-1) Q:'LSLOOP!(LSFOUND) D
...S STDAT=$G(^PS(52.49,PSOIEN,19,LSLOOP,0))
...S LSTAT=$P(STDAT,U,2)
...I $$GET1^DIQ(52.45,LSTAT,.01,"E")="HC" D S LSFOUND=1
....S LKNOWN=$O(^PS(52.49,PSOIEN,19,LSLOOP),-1)
....S LKNOWNE=$$GET1^DIQ(52.4919,LKNOWN_","_PSOIEN_",",.02,"E")
...I LKNOWNE="N"!(LKNOWNE="") S LKNOWNE="I"
..S RXSTATI=$$PRESOLV^PSOERXA1(LKNOWNE,"ERX")
..D UPDSTAT^PSOERXU1(PSOIEN,LKNOWNE,UHCOMM)
.W !,"eRx removed from hold status, and moved to '"_$$SENTENCE^XLFSTR($$GET1^DIQ(52.45,RXSTATI,.02,"E"))_"'."
.K DIR S DIR(0)="E" D ^DIR K DIR
.K @VALMAR D REF^PSOERSE1
S RXSTAT=$$UHSTS(PSOIEN),RXSTATI=$$PRESOLV^PSOERXA1(RXSTAT,"ERX")
I $G(HFFHOLD) K DIE S DIE="52.49",DA=PSOIEN,DR="6.7///@" D ^DIE K DIE
D UPDSTAT^PSOERXU1(PSOIEN,RXSTAT,UHCOMM)
W !,"eRx removed from hold status, and moved to '"_$$SENTENCE^XLFSTR($$GET1^DIQ(52.45,RXSTATI,.02,"E"))_"'."
K DIR S DIR(0)="E" D ^DIR K DIR
;Batch Un-Hold (Not an option for Future Fill Hold (HFF))
I '$G(HFFHOLD) D BATCHHLD^PSOERXH2(PSOIEN,HOLDIEN,UHCOMM,"U")
K @VALMAR D REF^PSOERSE1
Q
;
UHSTS(ERXIEN) ; Returns the eRx status after it's un-held
; Input: ERXIEN - Pointer to the eRx being worked on (Pointer to #52.49)
;Output: UHSTS - Status after eRx is un-held
;
N UHSTS,MTYPE,STSIEN
S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
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
. S STSIEN=$$PRESOLV^PSOERXA1($S(MTYPE="N":"W",MTYPE="RE":"RXW",MTYPE="CX":"CXW",1:""),"ERX") I 'STSIEN Q
. S UHSTS=$$GET1^DIQ(52.45,STSIEN,.01,"E")
I '$G(STSIEN) D
. S STSIEN=$$PRESOLV^PSOERXA1($S(MTYPE="N":"I",MTYPE="RE":"RXI",MTYPE="CX":"CXI",1:""),"ERX") I 'STSIEN Q
. S UHSTS=$$GET1^DIQ(52.45,STSIEN,.01,"E")
Q $G(UHSTS,"I")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXH1 6982 printed Dec 13, 2024@02:28:32 Page 2
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
+2 ;
+3 QUIT
+4 ; place eRx on Hold
HOLD ;
+1 NEW MBMSITE,DIE,DA,DR,CURSTAT,CSTATI,LMATCH,LSTAT,SUBFIEN,NEWSTAT,RESP,DIR,RXSTAT,HCOMM,MTYPE,HFFDT
+2 SET MBMSITE=$SELECT($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
+3 if '$GET(PSOIEN)
QUIT
+4 DO FULL^VALM1
SET VALMBCK="R"
+5 IF $$DONOTFIL^PSOERXUT(PSOIEN)
QUIT
+6 SET MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
+7 SET RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
+8 IF RXSTAT="RJ"!(RXSTAT="RM")!($GET(MBMSITE)&($EXTRACT(RXSTAT,1,3)="REM"))!(RXSTAT="PR")
Begin DoDot:1
+9 WRITE !!,"Cannot hold a prescription with a status of 'Rejected', 'Removed',",!,"or 'Processed",!
+10 SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+11 IF RXSTAT="RXP"!(RXSTAT="RXC")!(RXSTAT="RXE")
Begin DoDot:1
+12 WRITE !!,"Cannot hold a renewal response record that is in 'Complete', 'Processed', or 'Error' status.",!
End DoDot:1
QUIT
+13 ; check to see if the erx order status is a hold status
+14 SET CSTATI=$$GET1^DIQ(52.49,PSOIEN,1,"I")
+15 SET CURSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
+16 SET VALMBCK="R"
WRITE !
+17 IF $EXTRACT(CURSTAT,1)="H"
Begin DoDot:1
+18 SET DIR(0)="YO"
SET DIR("B")="NO"
+19 SET DIR("A",1)="This eRx is already in a 'HOLD' status."
+20 SET DIR("A")="Would you like to change the hold status and comments?"
+21 DO ^DIR
+22 if 'Y
QUIT
+23 KILL DIR
+24 SET RESP=$$HDIR(1)
+25 IF 'RESP
Begin DoDot:2
+26 WRITE !!,"Hold Reason required. eRx not placed in a 'Hold' status."
+27 KILL DIR,DA
SET DIR(0)="E"
DO ^DIR
End DoDot:2
QUIT
+28 KILL DIR,DA
SET DIR(0)="52.4919,1"
SET DIR("A")="Additional Comments (Optional)"
DO ^DIR
+29 IF Y="^"
WRITE !,"eRx NOT placed on hold."
KILL DIR
SET DIR(0)="E"
DO ^DIR
QUIT
+30 SET HCOMM=$GET(Y)
+31 SET DIE="52.49"
SET DA=PSOIEN
SET DR="1///"_RESP
DO ^DIE
KILL DIE
+32 SET SUBFIEN=$$NSTAT(PSOIEN,RESP,HCOMM)
+33 ;Refresh screen
KILL @VALMAR
DO REF^PSOERSE1
+34 SET PSORFRSH=1
End DoDot:1
QUIT
+35 KILL Y
+36 SET RESP=$$HDIR()
SET HFFDT=""
+37 IF 'RESP
Begin DoDot:1
+38 WRITE !!,"Hold Reason required. eRx not placed in a 'Hold' status."
+39 SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+40 IF $DATA(^PS(52.45,"B","HFF",RESP))
Begin DoDot:1
+41 WRITE !!,$GET(IOINHI),"The eRx will be un-held automatically on the date you enter below and placed"
+42 WRITE !,"in '",$$GET1^DIQ(52.45,$$GET1^DIQ(52.49,PSOIEN,1,"I"),.02),"' status.",$GET(IOINORM)
+43 KILL DIR
WRITE !
SET DIR(0)="DA^"_$$FMADD^XLFDT(DT,1)_":"_$SELECT($$GET1^DIQ(52.49,PSOIEN,95.1,"I"):$$FMADD^XLFDT(DT,185),1:$$FMADD^XLFDT(DT,364))_":EX"
+44 IF $$EFFDATE^PSOERXU5(PSOIEN,1)'=""
SET DIR("B")=$$FMTE^XLFDT($$EFFDATE^PSOERXU5(PSOIEN,1))
+45 SET DIR("A")="Future Fill Hold Date: "
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT
+46 SET HFFDT=Y
End DoDot:1
IF $DATA(DIRUT)!$DATA(DIROUT)
WRITE !,"eRx NOT placed on hold."
KILL DIR
SET DIR(0)="E"
DO ^DIR
QUIT
+47 WRITE !
KILL DIR,DA
SET DIR(0)="52.4919,1"
SET DIR("A")="Additional Comments (Optional)"
DO ^DIR
KILL DIR
+48 IF Y="^"
QUIT
+49 SET HCOMM=Y
+50 WRITE !,"Updating..."
+51 IF $GET(HFFDT)
KILL DIE
SET DIE="52.49"
SET DA=PSOIEN
SET DR="6.7///"_HFFDT
DO ^DIE
KILL DIE
+52 DO UPDSTAT^PSOERXU1(PSOIEN,$$GET1^DIQ(52.45,RESP,.01),HCOMM,,,$GET(HFFDT))
+53 HANG .5
WRITE "done.",$CHAR(7)
HANG 1
+54 SET PSORFRSH=1
+55 ; Batch Hold (Not an option for Future Fill Hold (HFF))
+56 IF '$DATA(^PS(52.45,"B","HFF",RESP))
DO BATCHHLD^PSOERXH2(PSOIEN,RESP,HCOMM,"H")
+57 DO REF^PSOERSE1
+58 QUIT
NSTAT(IEN,STAT,COMM) ;
+1 NEW SUBFIEN
+2 SET FDA(52.4919,"+1,"_IEN_",",.01)=$$NOW^XLFDT()
+3 SET FDA(52.4919,"+1,"_IEN_",",.02)=STAT
+4 SET FDA(52.4919,"+1,"_IEN_",",.03)=$GET(DUZ)
+5 SET FDA(52.4919,"+1,"_IEN_",",1)=COMM
+6 DO UPDATE^DIE(,"FDA","NEWSTAT")
KILL FDA
+7 SET SUBFIEN=$ORDER(NEWSTAT(0))
if 'SUBFIEN
QUIT
+8 SET SUBFIEN=$GET(NEWSTAT(SUBFIEN))
+9 QUIT SUBFIEN
HDIR(HTYP) ;
+1 NEW DIC,Y,X
+2 SET DIC("A")="Select HOLD reason code: "
+3 SET DIC="^PS(52.45,"
SET DIC(0)="AEMQ"
SET DIC("S")="I $D(^PS(52.45,""TYPE"",""ERX"",Y)),$E($P(^PS(52.45,Y,0),U),1)=""H"""
+4 DO ^DIC
KILL DIC
+5 IF Y<1
QUIT 0
+6 if '+$PIECE(Y,U)
QUIT 0
+7 QUIT $PIECE(Y,U)
+8 ; remove hold from eRx
UNHOLD ;
+1 NEW Y,DIR,DIE,DA,DR,NEWSIEN,RXSTAT,HFFHOLD,RXSTATI,MTYPE,QUIT,PEND,HOLDIEN
+2 DO FULL^VALM1
SET VALMBCK="R"
+3 IF $$DONOTFIL^PSOERXUT(PSOIEN)
QUIT
+4 SET MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
+5 SET PEND=$$GET1^DIQ(52.49,PSOIEN,25.2,"I")
+6 SET RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
SET HFFHOLD=0
IF RXSTAT="HFF"
SET HFFHOLD=1
+7 IF RXSTAT="RJ"!(RXSTAT="RM")!($GET(MBMSITE)&($EXTRACT(RXSTAT,1,3)="REM"))!(RXSTAT="PR")
Begin DoDot:1
+8 WRITE !!,"Cannot un-hold a prescription with a status of 'Rejected', 'Removed',",!,"or 'Processed",!
+9 SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+10 WRITE !
+11 IF $EXTRACT($$GET1^DIQ(52.49,PSOIEN,1,"E"),1)'="H"
Begin DoDot:1
+12 WRITE !,"This eRx is not currently on hold. Please use the 'Hold'",!,"function to update the hold status and comments.",!!
+13 KILL DIR,DA
SET DIR(0)="E"
+14 DO ^DIR
+15 KILL @VALMAR
DO REF^PSOERSE1
End DoDot:1
QUIT
+16 ; Un-Hold Comments
+17 SET DIR(0)="52.4919,1"
SET DIR("A")="Additional Comments (Optional)"
DO ^DIR
KILL DIR
+18 IF Y="^"
QUIT
+19 SET UHCOMM=$GET(Y)
+20 SET HOLDIEN=$$GET1^DIQ(52.49,PSOIEN,1,"I")
+21 ;
+22 IF RXSTAT="HC"
Begin DoDot:1
+23 WRITE !,"A change request has been generated for this NewRx record.",!,"Are you sure you like to unhold this prescription?"
+24 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="Y"
DO ^DIR
+25 IF Y<1
SET QUIT=1
End DoDot:1
+26 IF $GET(QUIT)
QUIT
+27 ; return processed records to PR - processed, so they cannot be finished again.
+28 IF PEND
IF RXSTAT="HC"
Begin DoDot:1
+29 IF PEND
Begin DoDot:2
+30 SET RXSTATI=$$PRESOLV^PSOERXA1("PR","ERX")
+31 DO UPDSTAT^PSOERXU1(PSOIEN,"PR",UHCOMM)
End DoDot:2
+32 IF 'PEND
Begin DoDot:2
+33 NEW LSFOUND,LSLOOP,STDAT,LSTAT,LKNOWN,LKNOWNE
+34 SET LSFOUND=0
+35 IF '$DATA(^PS(52.49,PSOIEN,19))
Begin DoDot:3
+36 IF MTYPE="N"
SET LKNOWNE="I"
+37 IF MTYPE="RE"
SET LKNOWNE="RXI"
+38 IF MTYPE="CX"
SET LKNOWNE="CXI"
End DoDot:3
+39 SET LSLOOP=99999
FOR
SET LSLOOP=$ORDER(^PS(52.49,PSOIEN,19,LSLOOP),-1)
if 'LSLOOP!(LSFOUND)
QUIT
Begin DoDot:3
+40 SET STDAT=$GET(^PS(52.49,PSOIEN,19,LSLOOP,0))
+41 SET LSTAT=$PIECE(STDAT,U,2)
+42 IF $$GET1^DIQ(52.45,LSTAT,.01,"E")="HC"
Begin DoDot:4
+43 SET LKNOWN=$ORDER(^PS(52.49,PSOIEN,19,LSLOOP),-1)
+44 SET LKNOWNE=$$GET1^DIQ(52.4919,LKNOWN_","_PSOIEN_",",.02,"E")
End DoDot:4
SET LSFOUND=1
+45 IF LKNOWNE="N"!(LKNOWNE="")
SET LKNOWNE="I"
End DoDot:3
+46 SET RXSTATI=$$PRESOLV^PSOERXA1(LKNOWNE,"ERX")
+47 DO UPDSTAT^PSOERXU1(PSOIEN,LKNOWNE,UHCOMM)
End DoDot:2
+48 WRITE !,"eRx removed from hold status, and moved to '"_$$SENTENCE^XLFSTR($$GET1^DIQ(52.45,RXSTATI,.02,"E"))_"'."
+49 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+50 KILL @VALMAR
DO REF^PSOERSE1
End DoDot:1
QUIT
+51 SET RXSTAT=$$UHSTS(PSOIEN)
SET RXSTATI=$$PRESOLV^PSOERXA1(RXSTAT,"ERX")
+52 IF $GET(HFFHOLD)
KILL DIE
SET DIE="52.49"
SET DA=PSOIEN
SET DR="6.7///@"
DO ^DIE
KILL DIE
+53 DO UPDSTAT^PSOERXU1(PSOIEN,RXSTAT,UHCOMM)
+54 WRITE !,"eRx removed from hold status, and moved to '"_$$SENTENCE^XLFSTR($$GET1^DIQ(52.45,RXSTATI,.02,"E"))_"'."
+55 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+56 ;Batch Un-Hold (Not an option for Future Fill Hold (HFF))
+57 IF '$GET(HFFHOLD)
DO BATCHHLD^PSOERXH2(PSOIEN,HOLDIEN,UHCOMM,"U")
+58 KILL @VALMAR
DO REF^PSOERSE1
+59 QUIT
+60 ;
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)
+2 ;Output: UHSTS - Status after eRx is un-held
+3 ;
+4 NEW UHSTS,MTYPE,STSIEN
+5 SET MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
+6 IF $$GET1^DIQ(52.49,ERXIEN,1.3,"I")
IF $$GET1^DIQ(52.49,ERXIEN,1.5,"I")
IF $$GET1^DIQ(52.49,ERXIEN,1.7,"I")
Begin DoDot:1
+7 SET STSIEN=$$PRESOLV^PSOERXA1($SELECT(MTYPE="N":"W",MTYPE="RE":"RXW",MTYPE="CX":"CXW",1:""),"ERX")
IF 'STSIEN
QUIT
+8 SET UHSTS=$$GET1^DIQ(52.45,STSIEN,.01,"E")
End DoDot:1
+9 IF '$GET(STSIEN)
Begin DoDot:1
+10 SET STSIEN=$$PRESOLV^PSOERXA1($SELECT(MTYPE="N":"I",MTYPE="RE":"RXI",MTYPE="CX":"CXI",1:""),"ERX")
IF 'STSIEN
QUIT
+11 SET UHSTS=$$GET1^DIQ(52.45,STSIEN,.01,"E")
End DoDot:1
+12 QUIT $GET(UHSTS,"I")
