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 ---[H[J[2J[HPSGWADE 1459 printed Oct 16, 2024@17:39:32 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 ;
