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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWEDIS 1014 printed Oct 16, 2024@17:40:08 Page 2
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
