- 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 Jan 18, 2025@03:27:32 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