ASUUDATA ; IHS/ITSC/LMH -NO DATA FOR RPT ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine is a utility which may be called by certain print
;templates to check and see if data exists for the sort parameters
;supplied for the report. It not, a 'No data for Report' message is
;written.
N X,X1,Y
S Y=$G(^XTMP("ASUR",ASUV("RPT"),0)) S Y=$P(Y,U,2) S:Y']"" Y=$G(DT) X ^DD("DD")
S ASUX("DT")=Y S:ASUX("DT")']"" ASUX("DT")=$G(ASUK("DT"))
S (ASUC("PG"),ASUX("NDTA"))=0,ASUX("AS")=$O(^XTMP("ASUR",ASUV("RPT"),0))
I ASUV("RPT")="R08"!(ASUV("RPT")="R06")!(ASUV("RPT")="R83")!(ASUV("RPT")="R23") D Q
.I ASUX("AS")']"" D NODATA Q
.S ASUV("AR")=$E(ASUX("AS"),1,2) D @ASUQ("HDR")
I $L(ASUX("AS"))=4 S ASUX("AS")=$E(ASUX("AS"),1,2)_0_$E(ASUX("AS"),3,4)
I ASUX("AS")]"",$L(ASUX("AS"))=5 D
.K ASUL(2,"STA","CD")
.S X=$E(ASUX("AS"),1,2),X1=$E(ASUX("AS"),4,5) D STAT^ASULARST
.I ASUV("RPT")="R11" D
..D DIS^ASUMDIRM($E(ASUX("AS"),3,$L(ASUX("AS"))))
..S ASUX("AG")=$O(^XTMP("ASUR",ASUV("RPT"),ASUX("AS"),""))
.D @ASUQ("HDR")
.S ASUV("ARST")=ASUX("AS"),ASUX("AS")=0
E D
.S X=ASUL(1,"AR","AP")
.I $D(ASUL(1,"AR","STA1")) D
..S X1=ASUL(1,"AR","STA1")
.E D
..S Y=$O(^ASUMS(0))
..I Y']"" D
...S ASUL(2,"STA","CD")="UK"
...S ASUL(2,"STA","NM")="UNKNOWN"
..E D
...S X1=$P($G(^ASUMS(X,0)),U)
.I $D(X1) D STAT^ASULARST
.S:ASUV("RPT")="R11" ASUX("AG")="N/A"
.D NODATA
Q
NODATA ;
N X
D @ASUQ("HDR")
S X=$P(ASUV("RPT"),"R",2) S:$E(X)=0 X=$E(X,2,$L(X))
W !!,"NO DATA FOR REPORT ",X
S ASUX("NDTA")=1
Q
ASUUDATA ; IHS/ITSC/LMH -NO DATA FOR RPT ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine is a utility which may be called by certain print
+3 ;templates to check and see if data exists for the sort parameters
+4 ;supplied for the report. It not, a 'No data for Report' message is
+5 ;written.
+6 NEW X,X1,Y
+7 SET Y=$GET(^XTMP("ASUR",ASUV("RPT"),0))
SET Y=$PIECE(Y,U,2)
IF Y']""
SET Y=$GET(DT)
XECUTE ^DD("DD")
+8 SET ASUX("DT")=Y
IF ASUX("DT")']""
SET ASUX("DT")=$GET(ASUK("DT"))
+9 SET (ASUC("PG"),ASUX("NDTA"))=0
SET ASUX("AS")=$ORDER(^XTMP("ASUR",ASUV("RPT"),0))
+10 IF ASUV("RPT")="R08"!(ASUV("RPT")="R06")!(ASUV("RPT")="R83")!(ASUV("RPT")="R23")
Begin DoDot:1
+11 IF ASUX("AS")']""
DO NODATA
QUIT
+12 SET ASUV("AR")=$EXTRACT(ASUX("AS"),1,2)
DO @ASUQ("HDR")
End DoDot:1
QUIT
+13 IF $LENGTH(ASUX("AS"))=4
SET ASUX("AS")=$EXTRACT(ASUX("AS"),1,2)_0_$EXTRACT(ASUX("AS"),3,4)
+14 IF ASUX("AS")]""
IF $LENGTH(ASUX("AS"))=5
Begin DoDot:1
+15 KILL ASUL(2,"STA","CD")
+16 SET X=$EXTRACT(ASUX("AS"),1,2)
SET X1=$EXTRACT(ASUX("AS"),4,5)
DO STAT^ASULARST
+17 IF ASUV("RPT")="R11"
Begin DoDot:2
+18 DO DIS^ASUMDIRM($EXTRACT(ASUX("AS"),3,$LENGTH(ASUX("AS"))))
+19 SET ASUX("AG")=$ORDER(^XTMP("ASUR",ASUV("RPT"),ASUX("AS"),""))
End DoDot:2
+20 DO @ASUQ("HDR")
+21 SET ASUV("ARST")=ASUX("AS")
SET ASUX("AS")=0
End DoDot:1
+22 IF '$TEST
Begin DoDot:1
+23 SET X=ASUL(1,"AR","AP")
+24 IF $DATA(ASUL(1,"AR","STA1"))
Begin DoDot:2
+25 SET X1=ASUL(1,"AR","STA1")
End DoDot:2
+26 IF '$TEST
Begin DoDot:2
+27 SET Y=$ORDER(^ASUMS(0))
+28 IF Y']""
Begin DoDot:3
+29 SET ASUL(2,"STA","CD")="UK"
+30 SET ASUL(2,"STA","NM")="UNKNOWN"
End DoDot:3
+31 IF '$TEST
Begin DoDot:3
+32 SET X1=$PIECE($GET(^ASUMS(X,0)),U)
End DoDot:3
End DoDot:2
+33 IF $DATA(X1)
DO STAT^ASULARST
+34 IF ASUV("RPT")="R11"
SET ASUX("AG")="N/A"
+35 DO NODATA
End DoDot:1
+36 QUIT
NODATA ;
+1 NEW X
+2 DO @ASUQ("HDR")
+3 SET X=$PIECE(ASUV("RPT"),"R",2)
IF $EXTRACT(X)=0
SET X=$EXTRACT(X,2,$LENGTH(X))
+4 WRITE !!,"NO DATA FOR REPORT ",X
+5 SET ASUX("NDTA")=1
+6 QUIT
