PSSDAWUT ;BIRM/MFR - ECME (BPS) Utilities ;10/15/04
;;1.0;PHARMACY DATA MANAGEMENT;**90,260**;9/30/97;Build 14
; Reference to File #9002313.24 in ICR #4715
;
DAWEXT(CODE) ; Returns description for DAW code (Dispense as Written)
N DIC,X,Y
S DIC=9002313.24,DIC(0)="Z",X=CODE D ^DIC
Q $P($G(Y(0)),"^",2)
;
INPUT ; Input Transform for DAW CODE
I $L(X)<1!($L(X)>2)!'$D(X) K X Q
I X="?" X ^DD(50,81,4) Q
S DIC("S")="I $P($G(^(0)),""^"",3)'=1"
S DIC(0)="QM",DIC="^BPS(9002313.24," D ^DIC
S X=$P(Y,U,2) K:Y<0 X
Q
;
HLP ; Executable help for DAW CODE field
N DIC,D,DO
S DIC("S")="I $P($G(^(0)),""^"",3)'=1"
S DIC="^BPS(9002313.24,",D="B",DIC(0)="" D DQ^DICQ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDAWUT 691 printed Oct 16, 2024@18:31:22 Page 2
PSSDAWUT ;BIRM/MFR - ECME (BPS) Utilities ;10/15/04
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**90,260**;9/30/97;Build 14
+2 ; Reference to File #9002313.24 in ICR #4715
+3 ;
DAWEXT(CODE) ; Returns description for DAW code (Dispense as Written)
+1 NEW DIC,X,Y
+2 SET DIC=9002313.24
SET DIC(0)="Z"
SET X=CODE
DO ^DIC
+3 QUIT $PIECE($GET(Y(0)),"^",2)
+4 ;
INPUT ; Input Transform for DAW CODE
+1 IF $LENGTH(X)<1!($LENGTH(X)>2)!'$DATA(X)
KILL X
QUIT
+2 IF X="?"
XECUTE ^DD(50,81,4)
QUIT
+3 SET DIC("S")="I $P($G(^(0)),""^"",3)'=1"
+4 SET DIC(0)="QM"
SET DIC="^BPS(9002313.24,"
DO ^DIC
+5 SET X=$PIECE(Y,U,2)
if Y<0
KILL X
+6 QUIT
+7 ;
HLP ; Executable help for DAW CODE field
+1 NEW DIC,D,DO
+2 SET DIC("S")="I $P($G(^(0)),""^"",3)'=1"
+3 SET DIC="^BPS(9002313.24,"
SET D="B"
SET DIC(0)=""
DO DQ^DICQ
+4 QUIT
