Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSODAWUT

PSODAWUT.m

Go to the documentation of this file.
  1. PSODAWUT ;BIRM/MFR - BPS (ECME) - DAW Utilities ;10/15/04
  1. ;;7.0;OUTPATIENT PHARMACY;**148,260,702,747**;DEC 1997;Build 7
  1. ; Reference to $$DAWEXT^PSSDAWUT in ICR #4708
  1. ;
  1. GETDAW(RX,RFL) ; Returns the DAW code for a specific Prescription/Fill
  1. ;Input: (r) RX - Rx IEN (#52)
  1. ; (o) RFL - Refill # (Default: most recent)
  1. ;
  1. N DAW
  1. I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
  1. I 'RFL S DAW=$$GET1^DIQ(52,RX,81)
  1. E S DAW=$$GET1^DIQ(52.1,RFL_","_RX,81)
  1. I DAW="" S DAW=0
  1. Q DAW
  1. ;
  1. SAVDAW(RX,RFL,DAW) ; - Saves the DAW code for a specific Prescription/Fill
  1. ;Input: (r) RX - Rx IEN (#52)
  1. ; (o) RFL - Refill # (Default: most recent)
  1. ;
  1. I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
  1. I DAW="" S DAW=0
  1. ;
  1. I $$GETDAW(RX,RFL)'=DAW D
  1. . D RXACT^PSOBPSU2(RX,RFL,"DAW CODE changed from "_$$GETDAW(RX,RFL)_" to "_DAW_".","E")
  1. ;
  1. N DIE,DA,DR
  1. S DR="81///"_DAW
  1. I 'RFL S DA=RX,DIE="^PSRX(" D ^DIE
  1. I RFL,$D(^PSRX(RX,1,RFL,0)) S DIE="^PSRX("_RX_",1,",DA(1)=RX,DA=RFL D ^DIE
  1. Q
  1. ;
  1. EDTDAW(RX,RFL,DAW) ; - Edits the DAW code for a specific Prescription/Fill W/OUT SAVING IT
  1. ;Input: (r) RX - Rx IEN (#52)
  1. ; (o) RFL - Refill # (Default: most recent)
  1. ; (o) DAW - Default DAW code (Default: from Rx file)
  1. ;Output: $$EDTDAW - DAW code selected or "^" (up arrow)
  1. ;
  1. N DIR,Y,DA
  1. ;
  1. I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
  1. I '$D(DAW) S DAW=$$GETDAW(RX,RFL)
  1. ;
  1. I $$STATUS^PSOBPSUT(RX,RFL)="" Q
  1. ;
  1. S DIR("S")="I $P($G(^(0)),""^"",3)'=1"
  1. S DIR(0)="52,81",DIR("B")=DAW D ^DIR I $D(DIRUT) S DAW="^" Q
  1. S DAW=Y W " - ",$$DAWEXT^PSSDAWUT(DAW)
  1. Q