PSSDAWUT.m

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

 ;;1.0;PHARMACY DATA MANAGEMENT;**90**;9/30/97

 ;Reference to File #9002313.24 supported by DBIA 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(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="^BPS(9002313.24,",D="B",DIC(0)="" D DQ^DICQ

 Q

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

 +1       ;;1.0;PHARMACY DATA MANAGEMENT;**90**;9/30/97

 +2       ;Reference to File #9002313.24 supported by DBIA 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(0)="QM"

           SET DIC="^BPS(9002313.24,"

           DO ^DIC

 +4        SET X=$PIECE(Y,U,2)

           IF Y<0

               KILL X

 +5        QUIT 

 +6       ;

HLP       ; Executable help for DAW CODE field

 +1        NEW DIC,D,DO

 +2        SET DIC="^BPS(9002313.24,"

           SET D="B"

           SET DIC(0)=""

           DO DQ^DICQ

 +3        QUIT