- 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 Jan 18, 2025@02:39:55 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 ;