- ASUUPLOG ; IHS/ITSC/LMH -UTILITY PRINT LOG FILE ;
- ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- ;This routine is involked to both save and print (involked at the top)
- ;or just print information saved (involked at entry point 'P')
- ;in the update log global ^XTMP("ASU0"). Physical inventory log messages
- ;are also saved and printed in the same way, except to ^XTMP("ASUR","R0V").
- S ASUK("LG","LN")=$G(ASUK("LG","LN"))+1
- S ASULX=$G(ASULX) S:ASULX']"" ASULX=0
- S ^ASURX(ASULX,ASUK("LG","LN"))=ASURX
- S:'$D(ASUK("PTR-Q")) ASUK("PTR-Q")=0
- I ASUK("PTR-Q") Q
- D:'$D(IO(0)) HOME^%ZIS U IO(0)
- X ASURX
- Q
- P ;EP -PRINT LOGS
- I $G(ASUK("PTR"))]"" D
- .W @ASUK(ASUK("PTR"),"IOF")
- E D
- .I '$D(IOF) D HOME^%ZIS U IO(0)
- .W @IOF
- S ASULX=$G(ASULX)
- S:ASULX']"" ASULX=$S($G(ASUL(1,"AR","WHSE")):0,1:"0D")
- S ASULX(0)=$S(ASULX=0:"Update",ASULX="0D":"Entered Transaction Extract",1:"Re-extract")
- W !,"Printout of ",ASULX(0)," Log Report",!
- F ASUC("LOG")=1:1 S ASULX(1)=$O(^ASURX(ASULX,$G(ASULX(1)))) Q:ASULX(1)="" D
- .S ASURX=^ASURX(ASULX,ASULX(1))
- .X ASURX
- I ASUC("LOG")'>1 W !!,"No Log on file for printing",!!
- K ASULX,ASURX,ASUC("LOG")
- Q
- V ;EP; SAVE OR PRINT INVENTORY LOG DATA
- S:'$D(ASUK("PTR-Q")) ASUK("PTR-Q")=0
- I ASUK("PTR-Q") D
- .S ASUK("LG","VL")=$G(ASUK("LG","VL"))+1
- .S ^XTMP("ASUR","R0V",ASUK("LG","VL"))=ASURX
- E D
- .D:'$D(IO(0)) HOME^%ZIS U IO(0)
- .X ASURX
- .S DIR(0)="E" D ^DIR K DIR
- Q
- PV ;EP -QUEUED JOB LISTING
- I '$D(^XTMP("ASUR","R0V")) Q
- D CLS^ASUUHDG
- W !!,"The following are S.A.M.S. Inventory System messages from Queued Jobs:",!!
- F S ASUK("LG","VL")=$O(^XTMP("ASUR","R0V",$G(ASUK("LG","VL")))) Q:ASUK("LG","VL")']"" D
- .X ^XTMP("ASUR","R0V",ASUK("LG","VL"))
- .S DIR(0)="E" D ^DIR K DIR
- W !!,"ALL MESSAGES HAVE BEEN PRINTED",!!
- S DIR(0)="E" D ^DIR K DIR
- K ^XTMP("ASUR","R0V"),ASUK("LG","VL")
- S ^XTMP("ASUR","R0V",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
- Q
- ASUUPLOG ; IHS/ITSC/LMH -UTILITY PRINT LOG FILE ;
- +1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- +2 ;This routine is involked to both save and print (involked at the top)
- +3 ;or just print information saved (involked at entry point 'P')
- +4 ;in the update log global ^XTMP("ASU0"). Physical inventory log messages
- +5 ;are also saved and printed in the same way, except to ^XTMP("ASUR","R0V").
- +6 SET ASUK("LG","LN")=$GET(ASUK("LG","LN"))+1
- +7 SET ASULX=$GET(ASULX)
- IF ASULX']""
- SET ASULX=0
- +8 SET ^ASURX(ASULX,ASUK("LG","LN"))=ASURX
- +9 IF '$DATA(ASUK("PTR-Q"))
- SET ASUK("PTR-Q")=0
- +10 IF ASUK("PTR-Q")
- QUIT
- +11 IF '$DATA(IO(0))
- DO HOME^%ZIS
- USE IO(0)
- +12 XECUTE ASURX
- +13 QUIT
- P ;EP -PRINT LOGS
- +1 IF $GET(ASUK("PTR"))]""
- Begin DoDot:1
- +2 WRITE @ASUK(ASUK("PTR"),"IOF")
- End DoDot:1
- +3 IF '$TEST
- Begin DoDot:1
- +4 IF '$DATA(IOF)
- DO HOME^%ZIS
- USE IO(0)
- +5 WRITE @IOF
- End DoDot:1
- +6 SET ASULX=$GET(ASULX)
- +7 IF ASULX']""
- SET ASULX=$SELECT($GET(ASUL(1,"AR","WHSE")):0,1:"0D")
- +8 SET ASULX(0)=$SELECT(ASULX=0:"Update",ASULX="0D":"Entered Transaction Extract",1:"Re-extract")
- +9 WRITE !,"Printout of ",ASULX(0)," Log Report",!
- +10 FOR ASUC("LOG")=1:1
- SET ASULX(1)=$ORDER(^ASURX(ASULX,$GET(ASULX(1))))
- IF ASULX(1)=""
- QUIT
- Begin DoDot:1
- +11 SET ASURX=^ASURX(ASULX,ASULX(1))
- +12 XECUTE ASURX
- End DoDot:1
- +13 IF ASUC("LOG")'>1
- WRITE !!,"No Log on file for printing",!!
- +14 KILL ASULX,ASURX,ASUC("LOG")
- +15 QUIT
- V ;EP; SAVE OR PRINT INVENTORY LOG DATA
- +1 IF '$DATA(ASUK("PTR-Q"))
- SET ASUK("PTR-Q")=0
- +2 IF ASUK("PTR-Q")
- Begin DoDot:1
- +3 SET ASUK("LG","VL")=$GET(ASUK("LG","VL"))+1
- +4 SET ^XTMP("ASUR","R0V",ASUK("LG","VL"))=ASURX
- End DoDot:1
- +5 IF '$TEST
- Begin DoDot:1
- +6 IF '$DATA(IO(0))
- DO HOME^%ZIS
- USE IO(0)
- +7 XECUTE ASURX
- +8 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- End DoDot:1
- +9 QUIT
- PV ;EP -QUEUED JOB LISTING
- +1 IF '$DATA(^XTMP("ASUR","R0V"))
- QUIT
- +2 DO CLS^ASUUHDG
- +3 WRITE !!,"The following are S.A.M.S. Inventory System messages from Queued Jobs:",!!
- +4 FOR
- SET ASUK("LG","VL")=$ORDER(^XTMP("ASUR","R0V",$GET(ASUK("LG","VL"))))
- IF ASUK("LG","VL")']""
- QUIT
- Begin DoDot:1
- +5 XECUTE ^XTMP("ASUR","R0V",ASUK("LG","VL"))
- +6 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- End DoDot:1
- +7 WRITE !!,"ALL MESSAGES HAVE BEEN PRINTED",!!
- +8 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +9 KILL ^XTMP("ASUR","R0V"),ASUK("LG","VL")
- +10 SET ^XTMP("ASUR","R0V",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
- +11 QUIT
