- 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 Jan 18, 2025@03:31:20 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