- ASUURHDR ; IHS/ITSC/LMH -PRINT HEADING NO RECS ;
- ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- ;This routine provides entry points for various print templates to
- ;invoke to print a report heading when there are no records to print.
- ;VARIABLE ASUH("STS") WILL BE SET BY OPTION -INDICATES STATUS
- DUEIN ;EP ;CHECK HEADINGS FOR DUE IN REPORTS
- S ASUH("IDIR")="^ASUT(1," G BEGIN
- RECEIPT ;EP ;CHECK HEADINGS FOR RECEIPT REPORTS
- S ASUH("IDIR")="^ASUT(2," G BEGIN
- ISSUE ;EP ;CHECK HEADINGS FOR ISSUE REPORTS
- S ASUH("IDIR")="^ASUT(3,"
- S ASUH("ISSTP")=$S($E($P(XQY0,U),7,7)="T":1,1:3)
- S ASUH("STAT")=$O(^ASUT(3,"AD",ASUH("ISSTP"),""))
- I ASUH("STAT")']"" G RESULT
- G BEGIN
- AREA ;EP ;CHECK HEADINGS FOR AREA TRANS REPORTS
- S ASUH("IDIR")="^ASUT(4," G BEGIN
- STAT ;EP ;CHECK HEADINGS FOR STATION TRANS REPORTS
- S ASUH("IDIR")="^ASUT(5," G BEGIN
- DIRECT ;EP ;CHECK HEADINGS FOR DIRECT ISSUE REPORTS
- S ASUH("IDIR")="^ASUT(7," G BEGIN
- ADJUST ;EP ;CHECK HEADINGS FOR ADJUSTMENT REPORTS
- S ASUH("IDIR")="^ASUT(6," G BEGIN
- BEGIN ;CHECK FOR DATA
- S ASUH("TYPE")=$E($P(XQY0,U),6,6)
- I ASUH("STS")="Q" D
- .F ASURPT="R","U","X" D STATUS Q:ASUH("STAT")]""
- .I 1
- E D
- .S ASURPT=ASUH("STS") D STATUS
- .I ASUH("STAT")']"",ASUH("STS")="U" S ASURPT="X" D STATUS
- RESULT ;
- I ASUH("STAT")']"" D
- .S ASUH("TPL")=$P(FLDS,"[",2),ASUH("TPL")=$P(ASUH("TPL"),"]"),ASUH("TPL#")="" I ASUH("TPL")]"" D
- ..S ASUH("TPL#")=$O(^DIPT("B",ASUH("TPL"),"")),ASUH("HEAD")=0
- .I ASUH("TPL#")]"" D
- ..S ASUH("HEAD")=1
- ..W @IOF,^DIPT(ASUH("TPL#"),"H"),!
- ..Q:'$D(^DIPT(ASUH("TPL#"),"ROU"))
- ..S ASUH("TPLROU")=^DIPT(ASUH("TPL#"),"ROU")
- ..S ASUH("TPLHDR")="HEAD"_ASUH("TPLROU")
- ..D @ASUH("TPLHDR")
- .W:'ASUH("HEAD") @IOF,$P(XQY0,U,2),!!
- .W !,"No data found for report."
- .K ASUH("TPL#"),ASUH("TPLROU"),ASUH("TPLHDR"),FLDS
- EXIT ;
- K ASURPT
- Q
- STATUS ;
- S ASUH("IDR1")=ASUH("IDIR")_"""C"","""_ASURPT_""","""")"
- S ASUH("STAT")=$O(@ASUH("IDR1"))
- I ASUH("STAT")]"" D DATE
- Q
- DATE ;
- S ASUH("SORT")=0
- F S ASUH("SORT")=$O(DPP(ASUH("SORT"))) Q:ASUH("SORT")="" Q:$P(DPP(ASUH("SORT")),U,3)["DATE"
- Q:ASUH("SORT")=""
- S ASUH("XREF")=$S($P(DPP(ASUH("SORT")),U,3)["PROC":"AC",1:"AX")
- S ASUH("1ST")=$P($G(DPP(ASUH("SORT"),"F")),".")
- S ASURPT=$S(ASUH("1ST")]"":ASUH("1ST")-1,1:"")
- S ASUH("IDR2")=ASUH("IDIR")_""""_ASUH("XREF")_""",ASURPT)"
- S ASUH("STAT")=$O(@ASUH("IDR2"))
- Q:ASUH("STAT")=ASUH("1ST")
- S ASUH("LAST")=$P($G(DPP(ASUH("SORT"),"T")),".")
- Q:ASUH("LAST")']""
- S:ASUH("STAT")>ASUH("LAST") ASUH("STAT")=""
- Q
- PAZ ;EP ;;PAUSE AT LAST SCREEN FOR REPORTS SENT TO TERMINAL
- G:$D(IO("Q")) EXIT
- G:$G(IO("S"))]"" EXIT
- I $E($G(IOST),1,2)="C-",ION'["HFS" N DIR S DIR(0)="E" D ^DIR
- G EXIT
- ASUURHDR ; IHS/ITSC/LMH -PRINT HEADING NO RECS ;
- +1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- +2 ;This routine provides entry points for various print templates to
- +3 ;invoke to print a report heading when there are no records to print.
- +4 ;VARIABLE ASUH("STS") WILL BE SET BY OPTION -INDICATES STATUS
- DUEIN ;EP ;CHECK HEADINGS FOR DUE IN REPORTS
- +1 SET ASUH("IDIR")="^ASUT(1,"
- GOTO BEGIN
- RECEIPT ;EP ;CHECK HEADINGS FOR RECEIPT REPORTS
- +1 SET ASUH("IDIR")="^ASUT(2,"
- GOTO BEGIN
- ISSUE ;EP ;CHECK HEADINGS FOR ISSUE REPORTS
- +1 SET ASUH("IDIR")="^ASUT(3,"
- +2 SET ASUH("ISSTP")=$SELECT($EXTRACT($PIECE(XQY0,U),7,7)="T":1,1:3)
- +3 SET ASUH("STAT")=$ORDER(^ASUT(3,"AD",ASUH("ISSTP"),""))
- +4 IF ASUH("STAT")']""
- GOTO RESULT
- +5 GOTO BEGIN
- AREA ;EP ;CHECK HEADINGS FOR AREA TRANS REPORTS
- +1 SET ASUH("IDIR")="^ASUT(4,"
- GOTO BEGIN
- STAT ;EP ;CHECK HEADINGS FOR STATION TRANS REPORTS
- +1 SET ASUH("IDIR")="^ASUT(5,"
- GOTO BEGIN
- DIRECT ;EP ;CHECK HEADINGS FOR DIRECT ISSUE REPORTS
- +1 SET ASUH("IDIR")="^ASUT(7,"
- GOTO BEGIN
- ADJUST ;EP ;CHECK HEADINGS FOR ADJUSTMENT REPORTS
- +1 SET ASUH("IDIR")="^ASUT(6,"
- GOTO BEGIN
- BEGIN ;CHECK FOR DATA
- +1 SET ASUH("TYPE")=$EXTRACT($PIECE(XQY0,U),6,6)
- +2 IF ASUH("STS")="Q"
- Begin DoDot:1
- +3 FOR ASURPT="R","U","X"
- DO STATUS
- IF ASUH("STAT")]""
- QUIT
- +4 IF 1
- End DoDot:1
- +5 IF '$TEST
- Begin DoDot:1
- +6 SET ASURPT=ASUH("STS")
- DO STATUS
- +7 IF ASUH("STAT")']""
- IF ASUH("STS")="U"
- SET ASURPT="X"
- DO STATUS
- End DoDot:1
- RESULT ;
- +1 IF ASUH("STAT")']""
- Begin DoDot:1
- +2 SET ASUH("TPL")=$PIECE(FLDS,"[",2)
- SET ASUH("TPL")=$PIECE(ASUH("TPL"),"]")
- SET ASUH("TPL#")=""
- IF ASUH("TPL")]""
- Begin DoDot:2
- +3 SET ASUH("TPL#")=$ORDER(^DIPT("B",ASUH("TPL"),""))
- SET ASUH("HEAD")=0
- End DoDot:2
- +4 IF ASUH("TPL#")]""
- Begin DoDot:2
- +5 SET ASUH("HEAD")=1
- +6 WRITE @IOF,^DIPT(ASUH("TPL#"),"H"),!
- +7 IF '$DATA(^DIPT(ASUH("TPL#"),"ROU"))
- QUIT
- +8 SET ASUH("TPLROU")=^DIPT(ASUH("TPL#"),"ROU")
- +9 SET ASUH("TPLHDR")="HEAD"_ASUH("TPLROU")
- +10 DO @ASUH("TPLHDR")
- End DoDot:2
- +11 IF 'ASUH("HEAD")
- WRITE @IOF,$PIECE(XQY0,U,2),!!
- +12 WRITE !,"No data found for report."
- +13 KILL ASUH("TPL#"),ASUH("TPLROU"),ASUH("TPLHDR"),FLDS
- End DoDot:1
- EXIT ;
- +1 KILL ASURPT
- +2 QUIT
- STATUS ;
- +1 SET ASUH("IDR1")=ASUH("IDIR")_"""C"","""_ASURPT_""","""")"
- +2 SET ASUH("STAT")=$ORDER(@ASUH("IDR1"))
- +3 IF ASUH("STAT")]""
- DO DATE
- +4 QUIT
- DATE ;
- +1 SET ASUH("SORT")=0
- +2 FOR
- SET ASUH("SORT")=$ORDER(DPP(ASUH("SORT")))
- IF ASUH("SORT")=""
- QUIT
- IF $PIECE(DPP(ASUH("SORT")),U,3)["DATE"
- QUIT
- +3 IF ASUH("SORT")=""
- QUIT
- +4 SET ASUH("XREF")=$SELECT($PIECE(DPP(ASUH("SORT")),U,3)["PROC":"AC",1:"AX")
- +5 SET ASUH("1ST")=$PIECE($GET(DPP(ASUH("SORT"),"F")),".")
- +6 SET ASURPT=$SELECT(ASUH("1ST")]"":ASUH("1ST")-1,1:"")
- +7 SET ASUH("IDR2")=ASUH("IDIR")_""""_ASUH("XREF")_""",ASURPT)"
- +8 SET ASUH("STAT")=$ORDER(@ASUH("IDR2"))
- +9 IF ASUH("STAT")=ASUH("1ST")
- QUIT
- +10 SET ASUH("LAST")=$PIECE($GET(DPP(ASUH("SORT"),"T")),".")
- +11 IF ASUH("LAST")']""
- QUIT
- +12 IF ASUH("STAT")>ASUH("LAST")
- SET ASUH("STAT")=""
- +13 QUIT
- PAZ ;EP ;;PAUSE AT LAST SCREEN FOR REPORTS SENT TO TERMINAL
- +1 IF $DATA(IO("Q"))
- GOTO EXIT
- +2 IF $GET(IO("S"))]""
- GOTO EXIT
- +3 IF $EXTRACT($GET(IOST),1,2)="C-"
- IF ION'["HFS"
- NEW DIR
- SET DIR(0)="E"
- DO ^DIR
- +4 GOTO EXIT
