- PSGWUTL1 ;BHAM ISC/CML-Utility routine for HELP functions ; 15 Aug 93 / 4:46 PM
- ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- SS ; Scroll-stop for last page of 80 column reports
- R !!,"END OF REPORT! Press <RETURN> to return to Menu:",SS:DTIME K SS Q
- HELP ; Help for scroll-stop
- W *7,!,"Please Enter: <RETURN> to continue viewing report or ""^"" to Exit report: "
- R ANS:DTIME S:'$T ANS="^" G:ANS?1."?" HELP Q
- ;***********************************************************************
- IG ; Reset Sort Keys for inventory groups
- F INVGRP=0:0 S INVGRP=$O(^PSI(58.2,INVGRP)) Q:'INVGRP I $O(^PSI(58.2,INVGRP,1,"D",0)) W "." D IGSET
- K INVGRP Q
- IGSET S CNT=0 F SK=0:0 S SK=$O(^PSI(58.2,INVGRP,1,"D",SK)) Q:'SK S AOU=$O(^PSI(58.2,INVGRP,1,"D",SK,0)),CNT=CNT+1,AOULP(CNT)=AOU
- F SK=0:0 S SK=$O(AOULP(SK)) Q:'SK S NSK=SK*100,DA(1)=INVGRP,DA=AOULP(SK),DIE="^PSI(58.2,"_DA(1)_",1,",DR="2///"_NSK D ^DIE
- K D,D0,DA,DI,DIC,DIE,DQ,DR,X,CNT,SK,NSK,AOU,AOULP Q
- ;***********************************************************************
- SEL ; Ask if reports are to print by Inventory Group or AOU
- W !!?5,"You may select a single AOU, several AOUs,",!?5,"or enter ""^ALL"" to select all AOUs.",!?20,"-OR-",!?5,"You may select an Inventory Group."
- ASKSEL ;
- W !!,"Do you want to select AOU(s) or an Inventory Group? (Enter 'A' or 'I'): " R SEL:DTIME S:'$T SEL="^" G:"^"[SEL QUIT I SEL?1."?" D HELPSEL G ASKSEL
- I SEL'="A"&(SEL'="I") W *7,"??" D HELPSEL G ASKSEL
- W !
- ASKIG Q:SEL="A" S DIC="^PSI(58.2,",DIC(0)="QEAM",DIC("S")="I $D(^PSI(58.2,""WS"",+Y))" D ^DIC K DIC I Y<0 K SEL Q
- S IGDA=+Y I '$O(^PSI(58.2,IGDA,1,0)) W *7,!!,"There are no AOUs defined for this Inventory Group!" G ASKIG
- F IGAOU=0:0 S IGAOU=$O(^PSI(58.2,IGDA,1,IGAOU)) Q:'IGAOU S AOULP(IGAOU)=""
- W !!,"This Inventory Group contains the following AOU(s):" F IGAOU=0:0 S IGAOU=$O(AOULP(IGAOU)) Q:'IGAOU W !?5,$P(^PSI(58.1,IGAOU,0),"^") I $D(^PSI(58.1,IGAOU,"I")),^("I"),^("I")'>DT W " *** INACTIVE ***"
- QUIT K:SEL="^"!(SEL="") SEL K %,IGAOU,DIC,X,Y Q
- HELPSEL ;
- W !!?5,"Enter an 'A' if you wish to select individual AOUs (one, several or ^ALL).",!?5,"Enter an 'I' if you wish to select all AOUs in an Inventory Group.",!?5,"Or enter ""^"" to Exit." Q
- PSGWDT() ;Find current date and time
- D NOW^%DTC
- S Y=$E(%,1,12)
- X ^DD("DD")
- Q Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWUTL1 2334 printed Jan 18, 2025@02:41:31 Page 2
- PSGWUTL1 ;BHAM ISC/CML-Utility routine for HELP functions ; 15 Aug 93 / 4:46 PM
- +1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- SS ; Scroll-stop for last page of 80 column reports
- +1 READ !!,"END OF REPORT! Press <RETURN> to return to Menu:",SS:DTIME
- KILL SS
- QUIT
- HELP ; Help for scroll-stop
- +1 WRITE *7,!,"Please Enter: <RETURN> to continue viewing report or ""^"" to Exit report: "
- +2 READ ANS:DTIME
- if '$TEST
- SET ANS="^"
- if ANS?1."?"
- GOTO HELP
- QUIT
- +3 ;***********************************************************************
- IG ; Reset Sort Keys for inventory groups
- +1 FOR INVGRP=0:0
- SET INVGRP=$ORDER(^PSI(58.2,INVGRP))
- if 'INVGRP
- QUIT
- IF $ORDER(^PSI(58.2,INVGRP,1,"D",0))
- WRITE "."
- DO IGSET
- +2 KILL INVGRP
- QUIT
- IGSET SET CNT=0
- FOR SK=0:0
- SET SK=$ORDER(^PSI(58.2,INVGRP,1,"D",SK))
- if 'SK
- QUIT
- SET AOU=$ORDER(^PSI(58.2,INVGRP,1,"D",SK,0))
- SET CNT=CNT+1
- SET AOULP(CNT)=AOU
- +1 FOR SK=0:0
- SET SK=$ORDER(AOULP(SK))
- if 'SK
- QUIT
- SET NSK=SK*100
- SET DA(1)=INVGRP
- SET DA=AOULP(SK)
- SET DIE="^PSI(58.2,"_DA(1)_",1,"
- SET DR="2///"_NSK
- DO ^DIE
- +2 KILL D,D0,DA,DI,DIC,DIE,DQ,DR,X,CNT,SK,NSK,AOU,AOULP
- QUIT
- +3 ;***********************************************************************
- SEL ; Ask if reports are to print by Inventory Group or AOU
- +1 WRITE !!?5,"You may select a single AOU, several AOUs,",!?5,"or enter ""^ALL"" to select all AOUs.",!?20,"-OR-",!?5,"You may select an Inventory Group."
- ASKSEL ;
- +1 WRITE !!,"Do you want to select AOU(s) or an Inventory Group? (Enter 'A' or 'I'): "
- READ SEL:DTIME
- if '$TEST
- SET SEL="^"
- if "^"[SEL
- GOTO QUIT
- IF SEL?1."?"
- DO HELPSEL
- GOTO ASKSEL
- +2 IF SEL'="A"&(SEL'="I")
- WRITE *7,"??"
- DO HELPSEL
- GOTO ASKSEL
- +3 WRITE !
- ASKIG if SEL="A"
- QUIT
- SET DIC="^PSI(58.2,"
- SET DIC(0)="QEAM"
- SET DIC("S")="I $D(^PSI(58.2,""WS"",+Y))"
- DO ^DIC
- KILL DIC
- IF Y<0
- KILL SEL
- QUIT
- +1 SET IGDA=+Y
- IF '$ORDER(^PSI(58.2,IGDA,1,0))
- WRITE *7,!!,"There are no AOUs defined for this Inventory Group!"
- GOTO ASKIG
- +2 FOR IGAOU=0:0
- SET IGAOU=$ORDER(^PSI(58.2,IGDA,1,IGAOU))
- if 'IGAOU
- QUIT
- SET AOULP(IGAOU)=""
- +3 WRITE !!,"This Inventory Group contains the following AOU(s):"
- FOR IGAOU=0:0
- SET IGAOU=$ORDER(AOULP(IGAOU))
- if 'IGAOU
- QUIT
- WRITE !?5,$PIECE(^PSI(58.1,IGAOU,0),"^")
- IF $DATA(^PSI(58.1,IGAOU,"I"))
- IF ^("I")
- IF ^("I")'>DT
- WRITE " *** INACTIVE ***"
- QUIT if SEL="^"!(SEL="")
- KILL SEL
- KILL %,IGAOU,DIC,X,Y
- QUIT
- HELPSEL ;
- +1 WRITE !!?5,"Enter an 'A' if you wish to select individual AOUs (one, several or ^ALL).",!?5,"Enter an 'I' if you wish to select all AOUs in an Inventory Group.",!?5,"Or enter ""^"" to Exit."
- QUIT
- PSGWDT() ;Find current date and time
- +1 DO NOW^%DTC
- +2 SET Y=$EXTRACT(%,1,12)
- +3 XECUTE ^DD("DD")
- +4 QUIT Y