PSGWADE.m

PSGWADE ;BHAM ISC/PTD,CML-Enter AMIS Data for All Drugs in All AOUs ; 02/13/90 10:19

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

 D NOW^%DTC S PSGWDT=$P(%,".") W !!,"You must enter ""^"" at any prompt to quit.",!,"Press <RETURN> at any prompt to skip that drug.",!!,"If the conversion number is ""1"", then YOU MUST",!,"KEY IN ""1""; no defaults are assumed!",!!

 ;BUILD UTILITY GLOBAL: ORDERED BY TYPE, DRUG NAME, & DRUG NUMBER

 W "I need to gather some information now.",!,"This may take a little while........."

AOU K ^TMP("PSGW",$J),^TMP("PSGWDN",$J) S PSGWFLG=1,PSGWRET=0 F PSGWAOU=0:0 S PSGWAOU=$O(^PSI(58.1,PSGWAOU)) G:'PSGWAOU LOOP^PSGWADE1 D XREF

 ;

XREF F PSGWDR=0:0 S PSGWDR=$O(^PSI(58.1,PSGWAOU,1,"B",PSGWDR)) Q:'PSGWDR  F PSGWITM=0:0 S PSGWITM=$O(^PSI(58.1,PSGWAOU,1,"B",PSGWDR,PSGWITM)) Q:'PSGWITM  D BUILD

 Q

 ;

BUILD I $P(^PSI(58.1,PSGWAOU,1,PSGWITM,0),"^",10)="Y",$P(^(0),"^",3)="" S $P(^(0),"^",10)=""

 I $P(^PSI(58.1,PSGWAOU,1,PSGWITM,0),"^",3)'="" Q:$P(^(0),"^",3)'>PSGWDT

 I '$O(^PSI(58.1,PSGWAOU,1,PSGWITM,2,0)) S K=9999 D SETGL Q

 F PSGWTY=0:0 S PSGWTY=$O(^PSI(58.1,PSGWAOU,1,PSGWITM,2,PSGWTY)) Q:'PSGWTY  S K=PSGWTY D SETGL S ^TMP("PSGWDN",$J,PSGWNM)=""

 Q

 ;

SETGL I '$O(^PSDRUG(PSGWDR,0)) S DIK="^PSI(58.1,"_PSGWAOU_",1,",DA=PSGWITM,DA(1)=PSGWAOU D ^DIK K DIK Q

 I $O(^PSDRUG(PSGWDR,0)) S PSGWNM=$S($P(^PSDRUG(PSGWDR,0),"^")'="":$P(^(0),"^"),1:"ZZNAME MISSING") S ^TMP("PSGW",$J,K,PSGWNM,PSGWDR)="" Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSGWADE   1459     printed  Apr 09, 2024@20:45:20                                                                                                                                                                                                     Page 2

PSGWADE   ;BHAM ISC/PTD,CML-Enter AMIS Data for All Drugs in All AOUs ; 02/13/90 10:19

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

 +2        DO NOW^%DTC

           SET PSGWDT=$PIECE(%,".")

           WRITE !!,"You must enter ""^"" at any prompt to quit.",!,"Press <RETURN> at any prompt to skip that drug.",!!,"If the conversion number is ""1"", then YOU MUST",!,"KEY IN ""1""; no defaults are assumed!",!!

 +3       ;BUILD UTILITY GLOBAL: ORDERED BY TYPE, DRUG NAME, & DRUG NUMBER

 +4        WRITE "I need to gather some information now.",!,"This may take a little while........."

AOU        KILL ^TMP("PSGW",$JOB),^TMP("PSGWDN",$JOB)

           SET PSGWFLG=1

           SET PSGWRET=0

           FOR PSGWAOU=0:0

               SET PSGWAOU=$ORDER(^PSI(58.1,PSGWAOU))

               if 'PSGWAOU

                   GOTO LOOP^PSGWADE1

               DO XREF

 +1       ;

XREF       FOR PSGWDR=0:0

               SET PSGWDR=$ORDER(^PSI(58.1,PSGWAOU,1,"B",PSGWDR))

               if 'PSGWDR

                   QUIT 

               FOR PSGWITM=0:0

                   SET PSGWITM=$ORDER(^PSI(58.1,PSGWAOU,1,"B",PSGWDR,PSGWITM))

                   if 'PSGWITM

                       QUIT 

                   DO BUILD

 +1        QUIT 

 +2       ;

BUILD      IF $PIECE(^PSI(58.1,PSGWAOU,1,PSGWITM,0),"^",10)="Y"

               IF $PIECE(^(0),"^",3)=""

                   SET $PIECE(^(0),"^",10)=""

 +1        IF $PIECE(^PSI(58.1,PSGWAOU,1,PSGWITM,0),"^",3)'=""

               if $PIECE(^(0),"^",3)'>PSGWDT

                   QUIT 

 +2        IF '$ORDER(^PSI(58.1,PSGWAOU,1,PSGWITM,2,0))

               SET K=9999

               DO SETGL

               QUIT 

 +3        FOR PSGWTY=0:0

               SET PSGWTY=$ORDER(^PSI(58.1,PSGWAOU,1,PSGWITM,2,PSGWTY))

               if 'PSGWTY

                   QUIT 

               SET K=PSGWTY

               DO SETGL

               SET ^TMP("PSGWDN",$JOB,PSGWNM)=""

 +4        QUIT 

 +5       ;

SETGL      IF '$ORDER(^PSDRUG(PSGWDR,0))

               SET DIK="^PSI(58.1,"_PSGWAOU_",1,"

               SET DA=PSGWITM

               SET DA(1)=PSGWAOU

               DO ^DIK

               KILL DIK

               QUIT 

 +1        IF $ORDER(^PSDRUG(PSGWDR,0))

               SET PSGWNM=$SELECT($PIECE(^PSDRUG(PSGWDR,0),"^")'="":$PIECE(^(0),"^"),1:"ZZNAME MISSING")

               SET ^TMP("PSGW",$JOB,K,PSGWNM,PSGWDR)=""

               QUIT 

 +2       ;