PSODAWUT ;BIRM/MFR - BPS (ECME) - DAW Utilities ;10/15/04
;;7.0;OUTPATIENT PHARMACY;**148,260,702,747**;DEC 1997;Build 7
; Reference to $$DAWEXT^PSSDAWUT in ICR #4708
;
GETDAW(RX,RFL) ; Returns the DAW code for a specific Prescription/Fill
;Input: (r) RX - Rx IEN (#52)
; (o) RFL - Refill # (Default: most recent)
;
N DAW
I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
I 'RFL S DAW=$$GET1^DIQ(52,RX,81)
E S DAW=$$GET1^DIQ(52.1,RFL_","_RX,81)
I DAW="" S DAW=0
Q DAW
;
SAVDAW(RX,RFL,DAW) ; - Saves the DAW code for a specific Prescription/Fill
;Input: (r) RX - Rx IEN (#52)
; (o) RFL - Refill # (Default: most recent)
;
I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
I DAW="" S DAW=0
;
I $$GETDAW(RX,RFL)'=DAW D
. D RXACT^PSOBPSU2(RX,RFL,"DAW CODE changed from "_$$GETDAW(RX,RFL)_" to "_DAW_".","E")
;
N DIE,DA,DR
S DR="81///"_DAW
I 'RFL S DA=RX,DIE="^PSRX(" D ^DIE
I RFL,$D(^PSRX(RX,1,RFL,0)) S DIE="^PSRX("_RX_",1,",DA(1)=RX,DA=RFL D ^DIE
Q
;
EDTDAW(RX,RFL,DAW) ; - Edits the DAW code for a specific Prescription/Fill W/OUT SAVING IT
;Input: (r) RX - Rx IEN (#52)
; (o) RFL - Refill # (Default: most recent)
; (o) DAW - Default DAW code (Default: from Rx file)
;Output: $$EDTDAW - DAW code selected or "^" (up arrow)
;
N DIR,Y,DA
;
I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
I '$D(DAW) S DAW=$$GETDAW(RX,RFL)
;
I $$STATUS^PSOBPSUT(RX,RFL)="" Q
;
S DIR("S")="I $P($G(^(0)),""^"",3)'=1"
S DIR(0)="52,81",DIR("B")=DAW D ^DIR I $D(DIRUT) S DAW="^" Q
S DAW=Y W " - ",$$DAWEXT^PSSDAWUT(DAW)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODAWUT 1598 printed Dec 13, 2024@02:26:23 Page 2
PSODAWUT ;BIRM/MFR - BPS (ECME) - DAW Utilities ;10/15/04
+1 ;;7.0;OUTPATIENT PHARMACY;**148,260,702,747**;DEC 1997;Build 7
+2 ; Reference to $$DAWEXT^PSSDAWUT in ICR #4708
+3 ;
GETDAW(RX,RFL) ; Returns the DAW code for a specific Prescription/Fill
+1 ;Input: (r) RX - Rx IEN (#52)
+2 ; (o) RFL - Refill # (Default: most recent)
+3 ;
+4 NEW DAW
+5 IF '$DATA(RFL)
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+6 IF 'RFL
SET DAW=$$GET1^DIQ(52,RX,81)
+7 IF '$TEST
SET DAW=$$GET1^DIQ(52.1,RFL_","_RX,81)
+8 IF DAW=""
SET DAW=0
+9 QUIT DAW
+10 ;
SAVDAW(RX,RFL,DAW) ; - Saves the DAW code for a specific Prescription/Fill
+1 ;Input: (r) RX - Rx IEN (#52)
+2 ; (o) RFL - Refill # (Default: most recent)
+3 ;
+4 IF '$DATA(RFL)
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+5 IF DAW=""
SET DAW=0
+6 ;
+7 IF $$GETDAW(RX,RFL)'=DAW
Begin DoDot:1
+8 DO RXACT^PSOBPSU2(RX,RFL,"DAW CODE changed from "_$$GETDAW(RX,RFL)_" to "_DAW_".","E")
End DoDot:1
+9 ;
+10 NEW DIE,DA,DR
+11 SET DR="81///"_DAW
+12 IF 'RFL
SET DA=RX
SET DIE="^PSRX("
DO ^DIE
+13 IF RFL
IF $DATA(^PSRX(RX,1,RFL,0))
SET DIE="^PSRX("_RX_",1,"
SET DA(1)=RX
SET DA=RFL
DO ^DIE
+14 QUIT
+15 ;
EDTDAW(RX,RFL,DAW) ; - Edits the DAW code for a specific Prescription/Fill W/OUT SAVING IT
+1 ;Input: (r) RX - Rx IEN (#52)
+2 ; (o) RFL - Refill # (Default: most recent)
+3 ; (o) DAW - Default DAW code (Default: from Rx file)
+4 ;Output: $$EDTDAW - DAW code selected or "^" (up arrow)
+5 ;
+6 NEW DIR,Y,DA
+7 ;
+8 IF '$DATA(RFL)
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+9 IF '$DATA(DAW)
SET DAW=$$GETDAW(RX,RFL)
+10 ;
+11 IF $$STATUS^PSOBPSUT(RX,RFL)=""
QUIT
+12 ;
+13 SET DIR("S")="I $P($G(^(0)),""^"",3)'=1"
+14 SET DIR(0)="52,81"
SET DIR("B")=DAW
DO ^DIR
IF $DATA(DIRUT)
SET DAW="^"
QUIT
+15 SET DAW=Y
WRITE " - ",$$DAWEXT^PSSDAWUT(DAW)
+16 QUIT
