PSODAWUT.m

PSODAWUT ;BIRM/MFR - BPS (ECME) - DAW Utilities ;10/15/04

 ;;7.0;OUTPATIENT PHARMACY;**148,260,702**;DEC 1997;Build 14

 ; 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)

 ;

 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)

 I 'RFL Q +$$GET1^DIQ(52,RX,81)

 Q +$$GET1^DIQ(52.1,RFL_","_RX,81)

 ;

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 $$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 ---PSODAWUT   1533     printed  Apr 09, 2024@21:32:57                                                                                                                                                                                                    Page 2

PSODAWUT  ;BIRM/MFR - BPS (ECME) - DAW Utilities ;10/15/04

 +1       ;;7.0;OUTPATIENT PHARMACY;**148,260,702**;DEC 1997;Build 14

 +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        IF '$DATA(RFL)

               SET RFL=$$LSTRFL^PSOBPSU1(RX)

 +5        IF 'RFL

               QUIT +$$GET1^DIQ(52,RX,81)

 +6        QUIT +$$GET1^DIQ(52.1,RFL_","_RX,81)

 +7       ;

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       ;

 +6        IF $$GETDAW(RX,RFL)'=DAW

               Begin DoDot:1

 +7                DO RXACT^PSOBPSU2(RX,RFL,"DAW CODE changed from "_$$GETDAW(RX,RFL)_" to "_DAW_".","E")

               End DoDot:1

 +8       ;

 +9        NEW DIE,DA,DR

 +10       SET DR="81///"_+DAW

 +11       IF 'RFL

               SET DA=RX

               SET DIE="^PSRX("

               DO ^DIE

 +12       IF RFL

               IF $DATA(^PSRX(RX,1,RFL,0))

                   SET DIE="^PSRX("_RX_",1,"

                   SET DA(1)=RX

                   SET DA=RFL

                   DO ^DIE

 +13       QUIT 

 +14      ;

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