PSGWEDIS.m

PSGWEDIS ;BHAM/CML-Input AOU 'INPATIENT SITE' field ; 07/19/90 10:27

 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94

START ;

 W !!,"This option will loop thru the PHARMACY AOU STOCK FILE (#58.1) and",!,"locate all ""ACTIVE"" AOUs that do not have an INPATIENT SITE defined." S EDFLG=0

 S AOU="" F JJ=0:0 S AOU=$O(^PSI(58.1,"B",AOU)) Q:AOU=""  S LL=$O(^PSI(58.1,"B",AOU,0)) Q:'LL  I $S('$D(^PSI(58.1,LL,"SITE")):1,'^("SITE"):1,1:0) I $S('$D(^PSI(58.1,LL,"I")):1,'^("I"):1,^("I")>DT:1,1:0) D ED I EDFLG="^" D WARN G QUIT

 I 'EDFLG W *7,!!,"ALL ACTIVE AOUs HAVE INPATIENT SITE DEFINED!!" G QUIT

 W *7,!!,"LOOP COMPLETED!"

QUIT K AOU,EDFLG,LL,D,D0,DA,DI,DIC,DISYS,DQ,DR,JJ,X,Y Q

ED ;

 Q:'$D(^PSI(58.1,LL,0))  W !!,"=> ",AOU S DIE="^PSI(58.1,",DA=LL,DR=4 D ^DIE K DIE S EDFLG=1 I $D(Y) S EDFLG="^" Q

 Q

WARN ;

 W *7,!!,"LOOP INTERRUPTED!",!!,"      *** Please complete this editing soon, it is VERY IMPORTANT that ***",!,"      *** all your AOUs have the INPATIENT SITE field defined.         ***" Q

PSGWEDIS  ;BHAM/CML-Input AOU 'INPATIENT SITE' field ; 07/19/90 10:27

 +1       ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94

START     ;

 +1        WRITE !!,"This option will loop thru the PHARMACY AOU STOCK FILE (#58.1) and",!,"locate all ""ACTIVE"" AOUs that do not have an INPATIENT SITE defined."

           SET EDFLG=0

 +2        SET AOU=""

           FOR JJ=0:0

               SET AOU=$ORDER(^PSI(58.1,"B",AOU))

               IF AOU=""

                   QUIT 

               SET LL=$ORDER(^PSI(58.1,"B",AOU,0))

               IF 'LL

                   QUIT 

               IF $SELECT('$DATA(^PSI(58.1,LL,"SITE")):1,'^("SITE"):1,1:0)

                   IF $SELECT('$DATA(^PSI(58.1,LL,"I")):1,'^("I"):1,^("I")>DT:1,1:0)

                       DO ED

                       IF EDFLG="^"

                           DO WARN

                           GOTO QUIT

 +3        IF 'EDFLG

               WRITE *7,!!,"ALL ACTIVE AOUs HAVE INPATIENT SITE DEFINED!!"

               GOTO QUIT

 +4        WRITE *7,!!,"LOOP COMPLETED!"

QUIT       KILL AOU,EDFLG,LL,D,D0,DA,DI,DIC,DISYS,DQ,DR,JJ,X,Y

           QUIT 

ED        ;

 +1        IF '$DATA(^PSI(58.1,LL,0))

               QUIT 

           WRITE !!,"=> ",AOU

           SET DIE="^PSI(58.1,"

           SET DA=LL

           SET DR=4

           DO ^DIE

           KILL DIE

           SET EDFLG=1

           IF $DATA(Y)

               SET EDFLG="^"

               QUIT 

 +2        QUIT 

WARN      ;

 +1        WRITE *7,!!,"LOOP INTERRUPTED!",!!,"      *** Please complete this editing soon, it is VERY IMPORTANT that ***",!,"      *** all your AOUs have the INPATIENT SITE field defined.         ***"

           QUIT