PSDCODE.m

PSDCODE ;BIR/JPW-Enter/Edit Drug Location Codes ; 6 July 94

 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

CODE ;entry for drug location codes into file 58.17

 K DA,DIC,DLAYGO F  W ! S (DIC,DLAYGO)=58.17,DIC(0)="QEAL",DIC("A")="Select DRUG ADDRESS CODE: " D ^DIC K DIC,DLAYGO Q:Y<0  K DA,DIE,DR S DIE=58.17,DA=+Y,DR=".01DRUG ADDRESS CODE;.5" D ^DIE K DIE,DR

END K DA,DIC,DIE,DLAYGO,DR,DTOUT,DUOUT,X,Y

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSDCODE   401     printed  Apr 09, 2024@20:51:37                                                                                                                                                                                                      Page 2

PSDCODE   ;BIR/JPW-Enter/Edit Drug Location Codes ; 6 July 94

 +1       ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

CODE      ;entry for drug location codes into file 58.17

 +1        KILL DA,DIC,DLAYGO

           FOR 

               WRITE !

               SET (DIC,DLAYGO)=58.17

               SET DIC(0)="QEAL"

               SET DIC("A")="Select DRUG ADDRESS CODE: "

               DO ^DIC

               KILL DIC,DLAYGO

               if Y<0

                   QUIT 

               KILL DA,DIE,DR

               SET DIE=58.17

               SET DA=+Y

               SET DR=".01DRUG ADDRESS CODE;.5"

               DO ^DIE

               KILL DIE,DR

END        KILL DA,DIC,DIE,DLAYGO,DR,DTOUT,DUOUT,X,Y