ASUURHDR.m

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