- ASURQSTD ; IHS/ITSC/LMH -QUATERLY UPDATE REPORTS DRIVER ;
- ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- ;This routine is used to print the Quarterly update series of
- ;reports - R81, and R82. It involkes routines ;ASURQ81P ^ASURQ82P
- K ^XTMP("ASUR","R81"),^XTMP("ASUR","R82")
- D SETQTR^ASUUDATE G EN
- PRINT ;EP; -PRINT PREVIOUS REPORTS
- I '$D(^XTMP("ASUR","R81")) D Q
- .S ASURX="W !,""No Data Available for Quarterly Reports"",!" D ^ASUUPLOG
- .S DIR(0)="E" D ^DIR
- EN ;EP;PRIMARY ENTRY POINT FOR QUARTERLY REPORTS
- I '$D(IO) D HOME^%ZIS
- I '$D(DUZ(2)) D Q
- .S ASURX="W !,""Report must be run from Kernel option"",!" D ^ASUUPLOG
- I '$D(ASUL(1,"AR","AP")) D SETAREA^ASULARST
- S ASUK("PTRSEL")=$G(ASUK("PTRSEL")) I ASUK("PTRSEL")]"" G PSER
- S ZTRTN="PSER^ASURQUPD",ZTDESC="SAMS Quarterly Reports" D O^ASUUZIS
- I POP S IOP=$I D ^%ZIS Q
- I ASUK(ASUK("PTR"),"Q") Q
- S ASUK("PTRSEL")=1
- PSER ;EP;FOR TASKMAN QUEUE OF PRINT
- I '$D(ASUP("TYP")) S ASUP("TYP")=0 D ^ASURQ25P,^ASURQ49P,^ASURQ81P,^ASURQ82P G DONE
- D TIME^ASUUDATE
- S ASURX="W !,""S.A.M.S. Quarterly Reports Printing Begun "_ASUK("DT","TIME")_"""" D ^ASUUPLOG
- ;S %H=$H D YX^%DTC
- D U^ASUUZIS
- I ASUP("CKM")=30 S ASUP("CKM")=31 D Q:ASUP("HLT")
- .D SETSM^ASUCOSTS K ^XTMP("ASUR","R25") S ^XTMP("ASUR","R25",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
- .D ^ASURQ25P
- I ASUP("CKM")=31 S ASUP("CKM")=32 D Q:ASUP("HLT")
- .D SETSM^ASUCOSTS K ^XTMP("ASUR","R49") S ^XTMP("ASUR","R49",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
- .D ^ASURQ49P
- I ASUP("CKM")=32 S ASUP("CKM")=33 D Q:ASUP("HLT")
- .D SETSM^ASUCOSTS K ^XTMP("ASUR","R81") S ^XTMP("ASUR","R81",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
- .D NEWQTR^ASURQ81P
- I ASUP("CKM")=33 S ASUP("CKM")=34 D Q:ASUP("HLT")
- .D SETSM^ASUCOSTS K ^XTMP("ASUR","R82") S ^XTMP("ASUR","R82",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
- .D ^ASURQ82P
- DONE ;
- U IO(0)
- D TIME^ASUUDATE
- S ASURX="W !,""S.A.M.S. Quarterly Reports Printing Ended "_ASUK("DT","TIME")_"""" D ^ASUUPLOG
- Q:ASUP("TYP")
- D C^ASUUZIS
- K ASUSV("TRCD"),ASUK("PTRSEL")
- Q
- ASURQSTD ; IHS/ITSC/LMH -QUATERLY UPDATE REPORTS DRIVER ;
- +1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- +2 ;This routine is used to print the Quarterly update series of
- +3 ;reports - R81, and R82. It involkes routines ;ASURQ81P ^ASURQ82P
- +4 KILL ^XTMP("ASUR","R81"),^XTMP("ASUR","R82")
- +5 DO SETQTR^ASUUDATE
- GOTO EN
- PRINT ;EP; -PRINT PREVIOUS REPORTS
- +1 IF '$DATA(^XTMP("ASUR","R81"))
- Begin DoDot:1
- +2 SET ASURX="W !,""No Data Available for Quarterly Reports"",!"
- DO ^ASUUPLOG
- +3 SET DIR(0)="E"
- DO ^DIR
- End DoDot:1
- QUIT
- EN ;EP;PRIMARY ENTRY POINT FOR QUARTERLY REPORTS
- +1 IF '$DATA(IO)
- DO HOME^%ZIS
- +2 IF '$DATA(DUZ(2))
- Begin DoDot:1
- +3 SET ASURX="W !,""Report must be run from Kernel option"",!"
- DO ^ASUUPLOG
- End DoDot:1
- QUIT
- +4 IF '$DATA(ASUL(1,"AR","AP"))
- DO SETAREA^ASULARST
- +5 SET ASUK("PTRSEL")=$GET(ASUK("PTRSEL"))
- IF ASUK("PTRSEL")]""
- GOTO PSER
- +6 SET ZTRTN="PSER^ASURQUPD"
- SET ZTDESC="SAMS Quarterly Reports"
- DO O^ASUUZIS
- +7 IF POP
- SET IOP=$IO
- DO ^%ZIS
- QUIT
- +8 IF ASUK(ASUK("PTR"),"Q")
- QUIT
- +9 SET ASUK("PTRSEL")=1
- PSER ;EP;FOR TASKMAN QUEUE OF PRINT
- +1 IF '$DATA(ASUP("TYP"))
- SET ASUP("TYP")=0
- DO ^ASURQ25P
- DO ^ASURQ49P
- DO ^ASURQ81P
- DO ^ASURQ82P
- GOTO DONE
- +2 DO TIME^ASUUDATE
- +3 SET ASURX="W !,""S.A.M.S. Quarterly Reports Printing Begun "_ASUK("DT","TIME")_""""
- DO ^ASUUPLOG
- +4 ;S %H=$H D YX^%DTC
- +5 DO U^ASUUZIS
- +6 IF ASUP("CKM")=30
- SET ASUP("CKM")=31
- Begin DoDot:1
- +7 DO SETSM^ASUCOSTS
- KILL ^XTMP("ASUR","R25")
- SET ^XTMP("ASUR","R25",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
- +8 DO ^ASURQ25P
- End DoDot:1
- IF ASUP("HLT")
- QUIT
- +9 IF ASUP("CKM")=31
- SET ASUP("CKM")=32
- Begin DoDot:1
- +10 DO SETSM^ASUCOSTS
- KILL ^XTMP("ASUR","R49")
- SET ^XTMP("ASUR","R49",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
- +11 DO ^ASURQ49P
- End DoDot:1
- IF ASUP("HLT")
- QUIT
- +12 IF ASUP("CKM")=32
- SET ASUP("CKM")=33
- Begin DoDot:1
- +13 DO SETSM^ASUCOSTS
- KILL ^XTMP("ASUR","R81")
- SET ^XTMP("ASUR","R81",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
- +14 DO NEWQTR^ASURQ81P
- End DoDot:1
- IF ASUP("HLT")
- QUIT
- +15 IF ASUP("CKM")=33
- SET ASUP("CKM")=34
- Begin DoDot:1
- +16 DO SETSM^ASUCOSTS
- KILL ^XTMP("ASUR","R82")
- SET ^XTMP("ASUR","R82",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
- +17 DO ^ASURQ82P
- End DoDot:1
- IF ASUP("HLT")
- QUIT
- DONE ;
- +1 USE IO(0)
- +2 DO TIME^ASUUDATE
- +3 SET ASURX="W !,""S.A.M.S. Quarterly Reports Printing Ended "_ASUK("DT","TIME")_""""
- DO ^ASUUPLOG
- +4 IF ASUP("TYP")
- QUIT
- +5 DO C^ASUUZIS
- +6 KILL ASUSV("TRCD"),ASUK("PTRSEL")
- +7 QUIT
