PSDGEN.m

PSDGEN ;BIR/JPW-Enter/Edit NAOU Inventory Groups ; 6 July 94

 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

 I '$D(PSDSITE) D ^PSDSET Q:'$D(PSDSITE)

GROUP ;entry for NAOU inventory groups into file 58.2

 K DA,DIC,DLAYGO F  W ! S (DIC,DLAYGO)=58.2,DIC("A")="Select NAOU INVENTORY GROUP NAME: ",DIC(0)="QEAL" D ^DIC K DIC,DLAYGO Q:Y<0  K DA,DIE,DR S DIE=58.2,DA=+Y,DR="[PSD INV GROUP]" D ^DIE K DA,DIE,DR

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

PSDGEN    ;BIR/JPW-Enter/Edit NAOU Inventory Groups ; 6 July 94

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

 +2        IF '$DATA(PSDSITE)

               DO ^PSDSET

               IF '$DATA(PSDSITE)

                   QUIT 

GROUP     ;entry for NAOU inventory groups into file 58.2

 +1        KILL DA,DIC,DLAYGO

           FOR 

               WRITE !

               SET (DIC,DLAYGO)=58.2

               SET DIC("A")="Select NAOU INVENTORY GROUP NAME: "

               SET DIC(0)="QEAL"

               DO ^DIC

               KILL DIC,DLAYGO

               IF Y<0

                   QUIT 

               KILL DA,DIE,DR

               SET DIE=58.2

               SET DA=+Y

               SET DR="[PSD INV GROUP]"

               DO ^DIE

               KILL DA,DIE,DR

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