PSOERXH2 ;BIR/MFR - eRx Hold Utilities ; 12/12/22 9:53am
;;7.0;OUTPATIENT PHARMACY;**700**;MAY 2021;Build 261
;
BATCHHLD(ERXIEN,HOLDIEN,HOLDCOMM,TYPE) ; Batch Hold/Un-Hold for Additional eRx (Same Day, Patient and Provider)
;Input: ERXIEN - eRx IEN (Pointer to #52.49)
; HOLDIEN - Hold Code IEN (Pointer to #52.45)
; HOLDCOMM - Hold/Un-Hold Comments
; TYPE - H: Hold | U:Un-Hold
N MSGDTTM,EPRVIEN,EPATIEN,RECDAT,HOLDERX,HOLDARR,MTYPE,NEWSTS
S MSGDTTM=$$GET1^DIQ(52.49,ERXIEN,.03,"I")
S EPRVIEN=+$$GET1^DIQ(52.49,ERXIEN,2.1,"I")
S EPATIEN=+$$GET1^DIQ(52.49,ERXIEN,.04,"I")
S RECDAT=MSGDTTM\1
F S RECDAT=$O(^PS(52.49,"PAT2",EPATIEN,RECDAT)) Q:'RECDAT!((RECDAT\1)'=(MSGDTTM\1)) D
. S HOLDERX=0 F S HOLDERX=$O(^PS(52.49,"PAT2",EPATIEN,RECDAT,HOLDERX)) Q:'HOLDERX D
. . I ERXIEN=HOLDERX Q
. . I TYPE="H",'$F(",I,N,",","_$$GET1^DIQ(52.49,HOLDERX,1,"E")_",") Q
. . I TYPE="U",HOLDIEN'=$$GET1^DIQ(52.49,HOLDERX,1,"I") Q
. . I EPRVIEN'=$$GET1^DIQ(52.49,HOLDERX,2.1,"I") Q
. . S HOLDARR(HOLDERX)=HOLDERX
I '$D(HOLDARR) Q
;
W !!,"The following prescriptions are from the same provider and received on the"
W !,"same day:",!
W !,"PROVIDER: "_$$GET1^DIQ(52.49,ERXIEN,2.1),?40,"eRx RECEIVED DATE: "_$$GET1^DIQ(52.49,ERXIEN,.03)
D LSTERXS^PSOERPT1(.HOLDARR,0,0)
W !
N X,Y,DIR,DTOUT,DUOUT,DIROUT,DIRUT
S DIR(0)="Y",DIR("A")="Do you want to "
I TYPE="H" S DIR("A")=DIR("A")_"put them on HOLD-"_$$GET1^DIQ(52.45,HOLDIEN,.01)
I TYPE="U" S DIR("A")=DIR("A")_"remove them from HOLD"
S DIR("B")="No" D ^DIR I '$G(Y) Q
;
W ?50,"Updating..."
S HOLDERX=0
F S HOLDERX=$O(HOLDARR(HOLDERX)) Q:'HOLDERX D
. I TYPE="H" S NEWSTS=HOLDIEN
. I TYPE="U" D
. . S MSGTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
. . I MSGTYPE="RE" S NEWSTS=$$PRESOLV^PSOERXA1("RXI","ERX") Q
. . I MSGTYPE="CX" S NEWSTS=$$PRESOLV^PSOERXA1("CXI","ERX") Q
. . S NEWSTS=$$PRESOLV^PSOERXA1("I","ERX")
. D UPDSTAT^PSOERXU1(HOLDERX,$$GET1^DIQ(52.45,NEWSTS,.01),HOLDCOMM)
. ;S DIE="52.49",DR="1////"_HOLDIEN,DA=HOLDERX D ^DIE K DIE
H .5 W "done.",$C(7) H 1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXH2 2112 printed Apr 09, 2024@21:35:15 Page 2
PSOERXH2 ;BIR/MFR - eRx Hold Utilities ; 12/12/22 9:53am
+1 ;;7.0;OUTPATIENT PHARMACY;**700**;MAY 2021;Build 261
+2 ;
BATCHHLD(ERXIEN,HOLDIEN,HOLDCOMM,TYPE) ; Batch Hold/Un-Hold for Additional eRx (Same Day, Patient and Provider)
+1 ;Input: ERXIEN - eRx IEN (Pointer to #52.49)
+2 ; HOLDIEN - Hold Code IEN (Pointer to #52.45)
+3 ; HOLDCOMM - Hold/Un-Hold Comments
+4 ; TYPE - H: Hold | U:Un-Hold
+5 NEW MSGDTTM,EPRVIEN,EPATIEN,RECDAT,HOLDERX,HOLDARR,MTYPE,NEWSTS
+6 SET MSGDTTM=$$GET1^DIQ(52.49,ERXIEN,.03,"I")
+7 SET EPRVIEN=+$$GET1^DIQ(52.49,ERXIEN,2.1,"I")
+8 SET EPATIEN=+$$GET1^DIQ(52.49,ERXIEN,.04,"I")
+9 SET RECDAT=MSGDTTM\1
+10 FOR
SET RECDAT=$ORDER(^PS(52.49,"PAT2",EPATIEN,RECDAT))
if 'RECDAT!((RECDAT\1)'=(MSGDTTM\1))
QUIT
Begin DoDot:1
+11 SET HOLDERX=0
FOR
SET HOLDERX=$ORDER(^PS(52.49,"PAT2",EPATIEN,RECDAT,HOLDERX))
if 'HOLDERX
QUIT
Begin DoDot:2
+12 IF ERXIEN=HOLDERX
QUIT
+13 IF TYPE="H"
IF '$FIND(",I,N,",","_$$GET1^DIQ(52.49,HOLDERX,1,"E")_",")
QUIT
+14 IF TYPE="U"
IF HOLDIEN'=$$GET1^DIQ(52.49,HOLDERX,1,"I")
QUIT
+15 IF EPRVIEN'=$$GET1^DIQ(52.49,HOLDERX,2.1,"I")
QUIT
+16 SET HOLDARR(HOLDERX)=HOLDERX
End DoDot:2
End DoDot:1
+17 IF '$DATA(HOLDARR)
QUIT
+18 ;
+19 WRITE !!,"The following prescriptions are from the same provider and received on the"
+20 WRITE !,"same day:",!
+21 WRITE !,"PROVIDER: "_$$GET1^DIQ(52.49,ERXIEN,2.1),?40,"eRx RECEIVED DATE: "_$$GET1^DIQ(52.49,ERXIEN,.03)
+22 DO LSTERXS^PSOERPT1(.HOLDARR,0,0)
+23 WRITE !
+24 NEW X,Y,DIR,DTOUT,DUOUT,DIROUT,DIRUT
+25 SET DIR(0)="Y"
SET DIR("A")="Do you want to "
+26 IF TYPE="H"
SET DIR("A")=DIR("A")_"put them on HOLD-"_$$GET1^DIQ(52.45,HOLDIEN,.01)
+27 IF TYPE="U"
SET DIR("A")=DIR("A")_"remove them from HOLD"
+28 SET DIR("B")="No"
DO ^DIR
IF '$GET(Y)
QUIT
+29 ;
+30 WRITE ?50,"Updating..."
+31 SET HOLDERX=0
+32 FOR
SET HOLDERX=$ORDER(HOLDARR(HOLDERX))
if 'HOLDERX
QUIT
Begin DoDot:1
+33 IF TYPE="H"
SET NEWSTS=HOLDIEN
+34 IF TYPE="U"
Begin DoDot:2
+35 SET MSGTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
+36 IF MSGTYPE="RE"
SET NEWSTS=$$PRESOLV^PSOERXA1("RXI","ERX")
QUIT
+37 IF MSGTYPE="CX"
SET NEWSTS=$$PRESOLV^PSOERXA1("CXI","ERX")
QUIT
+38 SET NEWSTS=$$PRESOLV^PSOERXA1("I","ERX")
End DoDot:2
+39 DO UPDSTAT^PSOERXU1(HOLDERX,$$GET1^DIQ(52.45,NEWSTS,.01),HOLDCOMM)
+40 ;S DIE="52.49",DR="1////"_HOLDIEN,DA=HOLDERX D ^DIE K DIE
End DoDot:1
+41 HANG .5
WRITE "done.",$CHAR(7)
HANG 1
+42 QUIT
