- 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 Feb 18, 2025@23:54:58 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")