PSGWPST1.m

PSGWPST1 ;BHAM ISC/KKA - POST INIT CONVERSION ROUTINE-CONT. ; 03 Sep 93 / 9:32 AM

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

POST5 ;Reindex "WS" cross-reference 

 S CNT=0

 W !!,"Now reindexing the ""WS"" cross-reference on the AREA OF USE (AOU) field of the",!,"AREA OF USE (AOU) subfile of the AOU INVENTORY GROUP file."

 S NAME=0 F  S NAME=$O(^PSI(58.2,NAME)) Q:'NAME  S AOU=0 F  S AOU=$O(^PSI(58.2,NAME,1,AOU)) Q:'AOU  S ^PSI(58.2,"WS",NAME,AOU)="" S CNT=CNT+1 W:CNT#10=0 "."

 K AOU,NAME,CNT

POST6 ;Delete unnecessary fields from options

 F PSGWOPT="PSGW AOU INV GROUP EDIT","PSGW AREA OF USE EDIT","PSGW INV TYPE EDIT","PSGW ITEM LOC EDIT","PSGW SITE" D

 .K DIC S DIC="^DIC(19,",DIC(0)="X",D="B"

 .S X=PSGWOPT D MIX^DIC1 Q:Y<0

 .K DA,DR,DIE,DIC S DA=+Y,DIE=19,DR="30///@;31///@;50///@;51///@" D ^DIE

 K DIC,DIE,DR,DA,D,PSGWOPT,X,Y Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSGWPST1   861     printed  Apr 09, 2024@20:44:08                                                                                                                                                                                                     Page 2

PSGWPST1  ;BHAM ISC/KKA - POST INIT CONVERSION ROUTINE-CONT. ; 03 Sep 93 / 9:32 AM

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

POST5     ;Reindex "WS" cross-reference 

 +1        SET CNT=0

 +2        WRITE !!,"Now reindexing the ""WS"" cross-reference on the AREA OF USE (AOU) field of the",!,"AREA OF USE (AOU) subfile of the AOU INVENTORY GROUP file."

 +3        SET NAME=0

           FOR 

               SET NAME=$ORDER(^PSI(58.2,NAME))

               if 'NAME

                   QUIT 

               SET AOU=0

               FOR 

                   SET AOU=$ORDER(^PSI(58.2,NAME,1,AOU))

                   if 'AOU

                       QUIT 

                   SET ^PSI(58.2,"WS",NAME,AOU)=""

                   SET CNT=CNT+1

                   if CNT#10=0

                       WRITE "."

 +4        KILL AOU,NAME,CNT

POST6     ;Delete unnecessary fields from options

 +1        FOR PSGWOPT="PSGW AOU INV GROUP EDIT","PSGW AREA OF USE EDIT","PSGW INV TYPE EDIT","PSGW ITEM LOC EDIT","PSGW SITE"

               Begin DoDot:1

 +2                KILL DIC

                   SET DIC="^DIC(19,"

                   SET DIC(0)="X"

                   SET D="B"

 +3                SET X=PSGWOPT

                   DO MIX^DIC1

                   if Y<0

                       QUIT 

 +4                KILL DA,DR,DIE,DIC

                   SET DA=+Y

                   SET DIE=19

                   SET DR="30///@;31///@;50///@;51///@"

                   DO ^DIE

               End DoDot:1

 +5        KILL DIC,DIE,DR,DA,D,PSGWOPT,X,Y

           QUIT