- 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
