PSOERXH1 ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
;;7.0;OUTPATIENT PHARMACY;**467,527,508,581,617,700,746,769,770**;DEC 1997;Build 145
;
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
. W ! 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
. 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)_":"_$$FMADD^XLFDT($$GET1^DIQ(52.49,PSOIEN,5.9,"I"),$S($$GET1^DIQ(52.49,PSOIEN,95.1,"I"):184,1:366))_":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
. 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
. D UPDSTAT^PSOERXU1(PSOIEN,$$GET1^DIQ(52.45,RESP,.01),HCOMM,,,$G(HFFDT))
. K @VALMAR D REF^PSOERSE1 ;Refresh screen
. 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
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..."
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,HOLDIEN
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") 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
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 6648 printed Aug 26, 2025@22:44:37 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,770**;DEC 1997;Build 145
+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 WRITE !
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 IF $DATA(^PS(52.45,"B","HFF",RESP))
Begin DoDot:2
+29 WRITE !!,$GET(IOINHI),"The eRx will be un-held automatically on the date you enter below and placed"
+30 WRITE !,"in '",$$GET1^DIQ(52.45,$$GET1^DIQ(52.49,PSOIEN,1,"I"),.02),"' status.",$GET(IOINORM)
+31 KILL DIR
WRITE !
SET DIR(0)="DA^"_$$FMADD^XLFDT(DT,1)_":"_$$FMADD^XLFDT($$GET1^DIQ(52.49,PSOIEN,5.9,"I"),$SELECT($$GET1^DIQ(52.49,PSOIEN,95.1,"I"):184,1:366))_":EX"
+32 IF $$EFFDATE^PSOERXU5(PSOIEN,1)'=""
SET DIR("B")=$$FMTE^XLFDT($$EFFDATE^PSOERXU5(PSOIEN,1))
+33 SET DIR("A")="Future Fill Hold Date: "
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT
+34 SET HFFDT=Y
End DoDot:2
IF $DATA(DIRUT)!$DATA(DIROUT)
WRITE !,"eRx NOT placed on hold."
KILL DIR
SET DIR(0)="E"
DO ^DIR
QUIT
+35 KILL DIR,DA
SET DIR(0)="52.4919,1"
SET DIR("A")="Additional Comments (Optional)"
DO ^DIR
+36 IF Y="^"
WRITE !,"eRx NOT placed on hold."
KILL DIR
SET DIR(0)="E"
DO ^DIR
QUIT
+37 SET HCOMM=$GET(Y)
+38 SET DIE="52.49"
SET DA=PSOIEN
SET DR="1///"_RESP
DO ^DIE
KILL DIE
+39 DO UPDSTAT^PSOERXU1(PSOIEN,$$GET1^DIQ(52.45,RESP,.01),HCOMM,,,$GET(HFFDT))
+40 ;Refresh screen
KILL @VALMAR
DO REF^PSOERSE1
+41 SET PSORFRSH=1
+42 ; Batch Hold (Not an option for Future Fill Hold (HFF))
+43 IF '$DATA(^PS(52.45,"B","HFF",RESP))
DO BATCHHLD^PSOERXH2(PSOIEN,RESP,HCOMM,"H")
+44 DO REF^PSOERSE1
End DoDot:1
QUIT
+45 KILL Y
+46 SET RESP=$$HDIR()
SET HFFDT=""
+47 IF 'RESP
Begin DoDot:1
+48 WRITE !!,"Hold Reason required. eRx not placed in a 'Hold' status."
+49 SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+50 IF $DATA(^PS(52.45,"B","HFF",RESP))
Begin DoDot:1
+51 WRITE !!,$GET(IOINHI),"The eRx will be un-held automatically on the date you enter below and placed"
+52 WRITE !,"in '",$$GET1^DIQ(52.45,$$GET1^DIQ(52.49,PSOIEN,1,"I"),.02),"' status.",$GET(IOINORM)
+53 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"
+54 IF $$EFFDATE^PSOERXU5(PSOIEN,1)'=""
SET DIR("B")=$$FMTE^XLFDT($$EFFDATE^PSOERXU5(PSOIEN,1))
+55 SET DIR("A")="Future Fill Hold Date: "
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT
+56 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
+57 WRITE !
KILL DIR,DA
SET DIR(0)="52.4919,1"
SET DIR("A")="Additional Comments (Optional)"
DO ^DIR
KILL DIR
+58 IF Y="^"
QUIT
+59 SET HCOMM=Y
+60 WRITE !,"Updating..."
+61 DO UPDSTAT^PSOERXU1(PSOIEN,$$GET1^DIQ(52.45,RESP,.01),HCOMM,,,$GET(HFFDT))
+62 HANG .5
WRITE "done.",$CHAR(7)
HANG 1
+63 SET PSORFRSH=1
+64 ; Batch Hold (Not an option for Future Fill Hold (HFF))
+65 IF '$DATA(^PS(52.45,"B","HFF",RESP))
DO BATCHHLD^PSOERXH2(PSOIEN,RESP,HCOMM,"H")
+66 DO REF^PSOERSE1
+67 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,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 RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
SET HFFHOLD=0
IF RXSTAT="HFF"
SET HFFHOLD=1
+6 IF RXSTAT="RJ"!(RXSTAT="RM")!($GET(MBMSITE)&($EXTRACT(RXSTAT,1,3)="REM"))!(RXSTAT="PR")
Begin DoDot:1
+7 WRITE !!,"Cannot un-hold a prescription with a status of 'Rejected', 'Removed',",!,"or 'Processed",!
+8 SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+9 WRITE !
+10 IF $EXTRACT($$GET1^DIQ(52.49,PSOIEN,1,"E"),1)'="H"
Begin DoDot:1
+11 WRITE !,"This eRx is not currently on hold. Please use the 'Hold'",!,"function to update the hold status and comments.",!!
+12 KILL DIR,DA
SET DIR(0)="E"
+13 DO ^DIR
+14 KILL @VALMAR
DO REF^PSOERSE1
End DoDot:1
QUIT
+15 ; Un-Hold Comments
+16 SET DIR(0)="52.4919,1"
SET DIR("A")="Additional Comments (Optional)"
DO ^DIR
KILL DIR
+17 IF Y="^"
QUIT
+18 SET UHCOMM=$GET(Y)
+19 SET HOLDIEN=$$GET1^DIQ(52.49,PSOIEN,1,"I")
+20 ;
+21 IF RXSTAT="HC"
Begin DoDot:1
+22 WRITE !,"A change request has been generated for this NewRx record.",!,"Are you sure you like to unhold this prescription?"
+23 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="Y"
DO ^DIR
+24 IF Y<1
SET QUIT=1
End DoDot:1
+25 IF $GET(QUIT)
QUIT
+26 SET RXSTAT=$$UHSTS(PSOIEN)
SET RXSTATI=$$PRESOLV^PSOERXA1(RXSTAT,"ERX")
+27 IF $GET(HFFHOLD)
KILL DIE
SET DIE="52.49"
SET DA=PSOIEN
SET DR="6.7///@"
DO ^DIE
KILL DIE
+28 DO UPDSTAT^PSOERXU1(PSOIEN,RXSTAT,UHCOMM)
+29 WRITE !,"eRx removed from hold status, and moved to '"_$$SENTENCE^XLFSTR($$GET1^DIQ(52.45,RXSTATI,.02,"E"))_"'."
+30 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+31 ;Batch Un-Hold (Not an option for Future Fill Hold (HFF))
+32 IF '$GET(HFFHOLD)
DO BATCHHLD^PSOERXH2(PSOIEN,HOLDIEN,UHCOMM,"U")
+33 KILL @VALMAR
DO REF^PSOERSE1
+34 QUIT
+35 ;
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")
