ASURM83P ; IHS/ITSC/LMH -RPT 83 INVOICE SUMMARY ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine formats and prints report 83 Invoice Summary
;Report.
I '$D(DUZ(2)) W !,"Report must be run from Kernel option" Q
I '$D(IO) D HOME^%ZIS
D:'$D(U) ^XBKVAR
D:'$D(ASUK("DT","FM")) DATE^ASUUDATE
I '$D(ASUL(1,"AR","AP")) D SETAREA^ASULARST
S ASUC("LN")=IOSL+1,(ASUC("PG"),ASUF("BK"))=0,ASUF("HDR")=1
D P0 Q:$D(DUOUT) Q:$D(DTOUT)
S ASUX("AO MO")=$P(^XTMP("ASUR","R83",0),U,2),ASUX("AO DT")=$P(^XTMP("ASUR","R83",0),U)
S ASUK("PTRSEL")=$G(ASUK("PTRSEL"))
I ASUK("PTRSEL")']"" D
.S ZTRTN="PSER^ASURM83P",ZTDESC="SAMS RPT 83" D O^ASUUZIS
.I POP S IOP=$I D ^%ZIS
I ASUK(ASUK("PTR"),"Q") Q
PSER ;EP;FOR TASKMAN QUEUE OF PRINT
D U^ASUUZIS
S ASUV("RPT")="R83",ASUQ("HDR")="HDR^ASURM83P"
D ^ASUUDATA I ASUX("NDTA") G KIL
S ASUT="R83",ASUT(ASUT,"PT","SST")=0
S (ASUX("LINE"),ASUV("VOU"))=""
S (ASUC("VAL"),ASUC("TRANS"),ASUC("VOU"),ASUC("USR"),ASUC("SSA"),ASUC("SST"),ASUC("AR"))=0
F ASUC("TR")=0:1 S ASUT(ASUT,"PT","SST")=$O(^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"))) Q:ASUT(ASUT,"PT","SST")="" D Q:$D(DUOUT)
.S ASUX("AR")=$E(ASUT(ASUT,"PT","SST"),1,2)
.D SST^ASULDIRR(ASUT(ASUT,"PT","SST"))
.S ASUT(ASUT,"PT","SSA")=""
.F S ASUT(ASUT,"PT","SSA")=$O(^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA"))) Q:ASUT(ASUT,"PT","SSA")="" D Q:$D(DUOUT)
..D SSA^ASULDIRR(ASUT(ASUT,"PT","SSA"))
..S ASUT(ASUT,"PT","USR")=""
..F S ASUT(ASUT,"PT","USR")=$O(^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA"),ASUT(ASUT,"PT","USR"))) Q:ASUT(ASUT,"PT","USR")="" D P1
..S ASUC("LN")=ASUC("LN")+2
..D:ASUC("LN")>(IOSL-2) HEADER Q:$D(DUOUT)
..W !?8,"TOTAL FOR SUB SUB ACTIVITY ",ASUL(17,"SSA")," ",ASUL(17,"SSA","NM"),?69,$J($FN(ASUC("USR"),",",2),10),!
..S ASUC("SSA")=$G(ASUC("SSA"))+ASUC("USR"),ASUC("USR")=0
..S ASUC("LN")=61,ASUF("HDR")=1
.W !!?5,"TOTAL FOR FACILITY ",ASUL(18,"SST")," ",ASUL(18,"SST","NM"),?69,$J($FN(ASUC("SSA"),",",2),10),!
.S ASUF("HDR")=1
.S ASUC("SST")=$G(ASUC("SST"))+ASUC("SSA"),ASUC("SSA")=0
.S ASUC("LN")=ASUC("LN")+3
I ASUC("LN")>(IOSL-2) D HEADER Q:$D(DUOUT)
W !!!?2,"TOTAL FOR AREA ",ASUL(1,"AR","AP")," ",ASUL(1,"AR","NM"),?69,$J($FN(ASUC("SST"),",",2),10),!
KIL ;
K ASUC,ASUF,ASUT,ASUV,ASUX
F X=3:1:22 K ASUL(X) ;Clear Table Lookup fields
K DIC,DA,X,Y
D PAZ^ASUURHDR
I ASUK("PTRSEL")]"" W @IOF Q
D C^ASUUZIS
Q
P0 ;
D:'$D(ASUK("DT","FM")) DATE^ASUUDATE
S ASUHDA=0,ASUX("AR")=ASUL(1,"AR","AP")
S ASUV("R83DT")=ASUK("DT","FM")
S ASUP("SEL83")=$G(ASUP("SEL83"))
I ASUX("AR")']"" S ^XTMP("ASUR","R83",1)="NONE" G EXIT
I ASUP("SEL83") D ;MENU SELECTED
.D CMPT
E D
.I $E($G(IOST),1,2)="C-",ION'["HFS" D
..K DIR S DIR(0)="Y",DIR("A")="Do you want to re-print the most recent Report 83"
..D ^DIR K DIR Q:$D(DUOUT) Q:$D(DTOUT)
.E D
..S Y=1
.I Y D ;
..I $L($O(^XTMP("ASUR","R83","")))>0 Q
..S X=$P(^ASUSITE(1,0),U,8)
..I X]"" D
...S ASUV("R83DT")=$P(^ASUSITE(1,0),U,8)
..E D
...S X=""
...F S X=$O(^ASUH("AX",X)) Q:X="" S ASUV("R83DT")=X
..D CMPT
.E D
..S DIR(0)="POA^ASUML(",DIR("A")="Enter the beginning date of the month to report " D ^DIR K DIR
..Q:$D(DUOUT) Q:$D(DTOUT) Q:X']"" Q:Y<0
..S ASUV("XLGMO")=+Y
..I $P(^ASUML(ASUV("XLGMO"),1,0),U,3)=1 D
...S ASUV("R83DT")=$P(^ASUML(ASUV("XLGMO"),1,1,0),U)
..E D
...W !!,"The month you have choosen had more than one Extract Process. One was likely"
...W !,"not for local update, ie. it was for DDPS processing only. You must now"
...W !,"indicate which Extract Process's records should be included on the report:",!!
...F Y=1:1 S X=$G(^ASUML(ASUV("XLGMO"),1,Y,0)) Q:X="" D
....W !?5,Y,?10,"DATE: ",$P(X,U)
....W !
...K DIR S DIR(0)="N:1:Y:0",DIR("A")="SELECT EXTRACT NUMBER (1-"_Y D ^DIR
...S ASUV("R83DT")=$P($G(^ASUML(ASUV("XLGMO"),1,+Y,0)),U)
..S X=$O(^ASUH("AX",ASUV("R83DT"),""))
..I X']"" D Q
...W !!,"NO REPORT 83 DATA FOR ",$S($D(Y(0)):Y(0),1:"SELECTED MONTH")
...S DUOUT=1
..K ^XTMP("ASUR","R83") S ^XTMP("ASUR","R83",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
..D CMPT
EXIT ;
Q
P1 ;
F X=19,20,22 K ASUL(X)
D REQ^ASULDIRR(ASUT(ASUT,"PT","USR"))
;LOGIC TO CAUSE PAGE BRK FOR DENTAL OR OEH FOR OKLAHOMA
I ASUX("AR")=50 I ASUL(19,"USR","NM")["DEN"!(ASUL(19,"USR","NM")["OEH") S ASUF("HDR")=1
S ASUT(ASUT,"VOU")=""
F S ASUT(ASUT,"VOU")=$O(^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA"),ASUT(ASUT,"PT","USR"),ASUT(ASUT,"VOU"))) Q:ASUT(ASUT,"VOU")="" D Q:$D(DUOUT)
.S ASUT("TRCD")=""
.F S ASUT("TRCD")=$O(^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA"),ASUT(ASUT,"PT","USR"),ASUT(ASUT,"VOU"),ASUT("TRCD"))) Q:ASUT("TRCD")="" D Q:$D(DUOUT)
..S ASUX("LINE")=""
..F S ASUX("LINE")=$O(^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA"),ASUT(ASUT,"PT","USR"),ASUT(ASUT,"VOU"),ASUT("TRCD"),ASUX("LINE"))) Q:ASUX("LINE")="" D Q:$D(DUOUT)
...I ASUF("HDR")!(ASUC("LN")>(IOSL-2)) D HEADER Q:$D(DUOUT)
...S ASUX(1)=^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA"),ASUT(ASUT,"PT","USR"),ASUT(ASUT,"VOU"),ASUT("TRCD"),ASUX("LINE"))
...S ASUT(ASUT,"CAN")=$P(ASUX(1),U),ASUT(ASUT,"VAL")=$P(ASUX(1),U,2)
...I $E(ASUT("TRCD"),2)?1A S ASUT(ASUT,"VAL")=ASUT(ASUT,"VAL")*-1
...S ASUV("VAL")=$FN(ASUT(ASUT,"VAL"),"+",2)
...S ASUC("VAL")=ASUC("VAL")+ASUV("VAL")
..W !,ASUL(17,"SSA"),?3,ASUL(17,"SSA","NM"),?27,ASUT(ASUT,"CAN"),?35,ASUL(20,"REQ"),?39,ASUL(19,"USR","NM")
..W ?55,ASUT(ASUT,"VOU")
..W ?66,ASUT("TRCD"),?69,$J($FN(ASUC("VAL"),",",2),10)
..S ASUC("LN")=ASUC("LN")+1
..S ASUC("VOU")=ASUC("VOU")+ASUC("VAL"),ASUC("VAL")=0
.W ! S ASUC("LN")=ASUC("LN")+1
W !?11,"TOTAL FOR USER ",?35,ASUL(20,"REQ"),?39,ASUL(19,"USR","NM"),?69,$J($FN(ASUC("VOU"),",",2),10),!
S ASUC("USR")=ASUC("USR")+ASUC("VOU"),ASUC("VOU")=0
S ASUF("HDR")=0
S ASUC("PG")=$G(ASUC("PG"))+1 D:ASUC("PG")>1 PAZ^ASUURHDR Q:$D(DUOUT) W @IOF
W "REPORT #83 MONTHLY INVOICE SUMMARY REPORT",?51,"DATE: ",$G(ASUK("DT")),?69,"PAGE :",$J(ASUC("PG"),5)
W !!,"CHARGED TO: AREA : ",?19,ASUL(1,"AR","AP")," ",$G(ASUL(1,"AR","NM"))
D:'$D(ASUL(18,"SST")) SST^ASULDIRR(ASUT(ASUT,"PT","SST"))
W !?13,"FAC : ",ASUL(18,"SST")," ",ASUL(18,"SST","NM")
W ?45,"AS OF MONTH: ",$G(ASUX("AO MO"))
W !!,"SUB",?55,"INVOICE"
W !,"SUB",?35,"USER",?55,"VOUCHER",?66,"P/"
W !,"ACT-NAME",?27,"CAN",?35,"CODE-NAME",?55,"NUMBER",?67,"C",?74,"VALUE",!
S ASUC("LN")=8
HDR ;
Q
CMPT ;EP ;COMPUTE EXTRACTS
K ^XTMP("ASUR","R83") S ASUT="ISS"
S ^XTMP("ASUR","R83",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
F ASUC("TR")=1:1 S ASUHDA=$O(^ASUH("AX",ASUV("R83DT"),$G(ASUHDA))) Q:ASUHDA="" Q:ASUHDA'?1N.N D
.;S $P(^ASUH(ASUHDA,0),U,5)=ASUK("DT","FM")
.S ASUT("TRCD")=$P(^ASUH(ASUHDA,1),U) Q:$E(ASUT("TRCD"))'=3
.Q:"3132333K3L"'[ASUT("TRCD")
.D READ^ASU0TRRD(.ASUHDA,"H") Q:$G(ASUT)']""
.Q:$E(ASUT(ASUT,"CAN"),2,3)'=ASUL(1,"AR","AP")
.I ASUT(ASUT,"PT","SST")']"" D
..D SST^ASULDIRR(ASUT(ASUT,"SST"))
..S ASUT(ASUT,"PT","SST")=ASUL(18,"SST","E#")
.I ASUT(ASUT,"PT","USR")']"" D
..D USR^ASULDIRR(ASUT(ASUT,"USR"))
..S ASUT(ASUT,"PT","USR")=ASUL(19,"USR","E#")
.I ASUT(ASUT,"PT","SST")']"" D
..D SSA^ASULDIRR(ASUT(ASUT,"SSA"))
..S ASUT(ASUT,"PT","SSA")=ASUL(17,"SSA","E#")
.S ^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA"),ASUT(ASUT,"PT","USR"),ASUT(ASUT,"VOU"),ASUT("TRCD"),ASUC("TR"))=ASUT(ASUT,"CAN")_U_ASUT(ASUT,"VAL")
K ASUT(ASUT)
S ^XTMP("ASUR","R83",0)=ASUK("DT","FM")_U_ASUK("DT","MONTH")
Q
ASURM83P ; IHS/ITSC/LMH -RPT 83 INVOICE SUMMARY ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine formats and prints report 83 Invoice Summary
+3 ;Report.
+4 IF '$DATA(DUZ(2))
WRITE !,"Report must be run from Kernel option"
QUIT
+5 IF '$DATA(IO)
DO HOME^%ZIS
+6 IF '$DATA(U)
DO ^XBKVAR
+7 IF '$DATA(ASUK("DT","FM"))
DO DATE^ASUUDATE
+8 IF '$DATA(ASUL(1,"AR","AP"))
DO SETAREA^ASULARST
+9 SET ASUC("LN")=IOSL+1
SET (ASUC("PG"),ASUF("BK"))=0
SET ASUF("HDR")=1
+10 DO P0
IF $DATA(DUOUT)
QUIT
IF $DATA(DTOUT)
QUIT
+11 SET ASUX("AO MO")=$PIECE(^XTMP("ASUR","R83",0),U,2)
SET ASUX("AO DT")=$PIECE(^XTMP("ASUR","R83",0),U)
+12 SET ASUK("PTRSEL")=$GET(ASUK("PTRSEL"))
+13 IF ASUK("PTRSEL")']""
Begin DoDot:1
+14 SET ZTRTN="PSER^ASURM83P"
SET ZTDESC="SAMS RPT 83"
DO O^ASUUZIS
+15 IF POP
SET IOP=$IO
DO ^%ZIS
End DoDot:1
+16 IF ASUK(ASUK("PTR"),"Q")
QUIT
PSER ;EP;FOR TASKMAN QUEUE OF PRINT
+1 DO U^ASUUZIS
+2 SET ASUV("RPT")="R83"
SET ASUQ("HDR")="HDR^ASURM83P"
+3 DO ^ASUUDATA
IF ASUX("NDTA")
GOTO KIL
+4 SET ASUT="R83"
SET ASUT(ASUT,"PT","SST")=0
+5 SET (ASUX("LINE"),ASUV("VOU"))=""
+6 SET (ASUC("VAL"),ASUC("TRANS"),ASUC("VOU"),ASUC("USR"),ASUC("SSA"),ASUC("SST"),ASUC("AR"))=0
+7 FOR ASUC("TR")=0:1
SET ASUT(ASUT,"PT","SST")=$ORDER(^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST")))
IF ASUT(ASUT,"PT","SST")=""
QUIT
Begin DoDot:1
+8 SET ASUX("AR")=$EXTRACT(ASUT(ASUT,"PT","SST"),1,2)
+9 DO SST^ASULDIRR(ASUT(ASUT,"PT","SST"))
+10 SET ASUT(ASUT,"PT","SSA")=""
+11 FOR
SET ASUT(ASUT,"PT","SSA")=$ORDER(^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA")))
IF ASUT(ASUT,"PT","SSA")=""
QUIT
Begin DoDot:2
+12 DO SSA^ASULDIRR(ASUT(ASUT,"PT","SSA"))
+13 SET ASUT(ASUT,"PT","USR")=""
+14 FOR
SET ASUT(ASUT,"PT","USR")=$ORDER(^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA"),ASUT(ASUT,"PT","USR")))
IF ASUT(ASUT,"PT","USR")=""
QUIT
DO P1
+15 SET ASUC("LN")=ASUC("LN")+2
+16 IF ASUC("LN")>(IOSL-2)
DO HEADER
IF $DATA(DUOUT)
QUIT
+17 WRITE !?8,"TOTAL FOR SUB SUB ACTIVITY ",ASUL(17,"SSA")," ",ASUL(17,"SSA","NM"),?69,$JUSTIFY($FNUMBER(ASUC("USR"),",",2),10),!
+18 SET ASUC("SSA")=$GET(ASUC("SSA"))+ASUC("USR")
SET ASUC("USR")=0
+19 SET ASUC("LN")=61
SET ASUF("HDR")=1
End DoDot:2
IF $DATA(DUOUT)
QUIT
+20 WRITE !!?5,"TOTAL FOR FACILITY ",ASUL(18,"SST")," ",ASUL(18,"SST","NM"),?69,$JUSTIFY($FNUMBER(ASUC("SSA"),",",2),10),!
+21 SET ASUF("HDR")=1
+22 SET ASUC("SST")=$GET(ASUC("SST"))+ASUC("SSA")
SET ASUC("SSA")=0
+23 SET ASUC("LN")=ASUC("LN")+3
End DoDot:1
IF $DATA(DUOUT)
QUIT
+24 IF ASUC("LN")>(IOSL-2)
DO HEADER
IF $DATA(DUOUT)
QUIT
+25 WRITE !!!?2,"TOTAL FOR AREA ",ASUL(1,"AR","AP")," ",ASUL(1,"AR","NM"),?69,$JUSTIFY($FNUMBER(ASUC("SST"),",",2),10),!
KIL ;
+1 KILL ASUC,ASUF,ASUT,ASUV,ASUX
+2 ;Clear Table Lookup fields
FOR X=3:1:22
KILL ASUL(X)
+3 KILL DIC,DA,X,Y
+4 DO PAZ^ASUURHDR
+5 IF ASUK("PTRSEL")]""
WRITE @IOF
QUIT
+6 DO C^ASUUZIS
+7 QUIT
P0 ;
+1 IF '$DATA(ASUK("DT","FM"))
DO DATE^ASUUDATE
+2 SET ASUHDA=0
SET ASUX("AR")=ASUL(1,"AR","AP")
+3 SET ASUV("R83DT")=ASUK("DT","FM")
+4 SET ASUP("SEL83")=$GET(ASUP("SEL83"))
+5 IF ASUX("AR")']""
SET ^XTMP("ASUR","R83",1)="NONE"
GOTO EXIT
+6 ;MENU SELECTED
IF ASUP("SEL83")
Begin DoDot:1
+7 DO CMPT
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 IF $EXTRACT($GET(IOST),1,2)="C-"
IF ION'["HFS"
Begin DoDot:2
+10 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to re-print the most recent Report 83"
+11 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
QUIT
IF $DATA(DTOUT)
QUIT
End DoDot:2
+12 IF '$TEST
Begin DoDot:2
+13 SET Y=1
End DoDot:2
+14 ;
IF Y
Begin DoDot:2
+15 IF $LENGTH($ORDER(^XTMP("ASUR","R83","")))>0
QUIT
+16 SET X=$PIECE(^ASUSITE(1,0),U,8)
+17 IF X]""
Begin DoDot:3
+18 SET ASUV("R83DT")=$PIECE(^ASUSITE(1,0),U,8)
End DoDot:3
+19 IF '$TEST
Begin DoDot:3
+20 SET X=""
+21 FOR
SET X=$ORDER(^ASUH("AX",X))
IF X=""
QUIT
SET ASUV("R83DT")=X
End DoDot:3
+22 DO CMPT
End DoDot:2
+23 IF '$TEST
Begin DoDot:2
+24 SET DIR(0)="POA^ASUML("
SET DIR("A")="Enter the beginning date of the month to report "
DO ^DIR
KILL DIR
+25 IF $DATA(DUOUT)
QUIT
IF $DATA(DTOUT)
QUIT
IF X']""
QUIT
IF Y<0
QUIT
+26 SET ASUV("XLGMO")=+Y
+27 IF $PIECE(^ASUML(ASUV("XLGMO"),1,0),U,3)=1
Begin DoDot:3
+28 SET ASUV("R83DT")=$PIECE(^ASUML(ASUV("XLGMO"),1,1,0),U)
End DoDot:3
+29 IF '$TEST
Begin DoDot:3
+30 WRITE !!,"The month you have choosen had more than one Extract Process. One was likely"
+31 WRITE !,"not for local update, ie. it was for DDPS processing only. You must now"
+32 WRITE !,"indicate which Extract Process's records should be included on the report:",!!
+33 FOR Y=1:1
SET X=$GET(^ASUML(ASUV("XLGMO"),1,Y,0))
IF X=""
QUIT
Begin DoDot:4
+34 WRITE !?5,Y,?10,"DATE: ",$PIECE(X,U)
+35 WRITE !
End DoDot:4
+36 KILL DIR
SET DIR(0)="N:1:Y:0"
SET DIR("A")="SELECT EXTRACT NUMBER (1-"_Y
DO ^DIR
+37 SET ASUV("R83DT")=$PIECE($GET(^ASUML(ASUV("XLGMO"),1,+Y,0)),U)
End DoDot:3
+38 SET X=$ORDER(^ASUH("AX",ASUV("R83DT"),""))
+39 IF X']""
Begin DoDot:3
+40 WRITE !!,"NO REPORT 83 DATA FOR ",$SELECT($DATA(Y(0)):Y(0),1:"SELECTED MONTH")
+41 SET DUOUT=1
End DoDot:3
QUIT
+42 KILL ^XTMP("ASUR","R83")
SET ^XTMP("ASUR","R83",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
+43 DO CMPT
End DoDot:2
End DoDot:1
EXIT ;
+1 QUIT
P1 ;
+1 FOR X=19,20,22
KILL ASUL(X)
+2 DO REQ^ASULDIRR(ASUT(ASUT,"PT","USR"))
+3 ;LOGIC TO CAUSE PAGE BRK FOR DENTAL OR OEH FOR OKLAHOMA
+4 IF ASUX("AR")=50
IF ASUL(19,"USR","NM")["DEN"!(ASUL(19,"USR","NM")["OEH")
SET ASUF("HDR")=1
+5 SET ASUT(ASUT,"VOU")=""
+6 FOR
SET ASUT(ASUT,"VOU")=$ORDER(^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA"),ASUT(ASUT,"PT","USR"),ASUT(ASUT,"VOU")))
IF ASUT(ASUT,"VOU")=""
QUIT
Begin DoDot:1
+7 SET ASUT("TRCD")=""
+8 FOR
SET ASUT("TRCD")=$ORDER(^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA"),ASUT(ASUT,"PT","USR"),ASUT(ASUT,"VOU"),ASUT("TRCD")))
IF ASUT("TRCD")=""
QUIT
Begin DoDot:2
+9 SET ASUX("LINE")=""
+10 FOR
SET ASUX("LINE")=$ORDER(^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA"),ASUT(ASUT,"PT","USR"),ASUT(ASUT,"VOU"),ASUT("TRCD"),ASUX("LINE")))
IF ASUX("LINE")=""
QUIT
Begin DoDot:3
+11 IF ASUF("HDR")!(ASUC("LN")>(IOSL-2))
DO HEADER
IF $DATA(DUOUT)
QUIT
+12 SET ASUX(1)=^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA"),ASUT(ASUT,"PT","USR"),ASUT(ASUT,"VOU"),ASUT("TRCD"),ASUX("LINE"))
+13 SET ASUT(ASUT,"CAN")=$PIECE(ASUX(1),U)
SET ASUT(ASUT,"VAL")=$PIECE(ASUX(1),U,2)
+14 IF $EXTRACT(ASUT("TRCD"),2)?1A
SET ASUT(ASUT,"VAL")=ASUT(ASUT,"VAL")*-1
+15 SET ASUV("VAL")=$FNUMBER(ASUT(ASUT,"VAL"),"+",2)
+16 SET ASUC("VAL")=ASUC("VAL")+ASUV("VAL")
End DoDot:3
IF $DATA(DUOUT)
QUIT
+17 WRITE !,ASUL(17,"SSA"),?3,ASUL(17,"SSA","NM"),?27,ASUT(ASUT,"CAN"),?35,ASUL(20,"REQ"),?39,ASUL(19,"USR","NM")
+18 WRITE ?55,ASUT(ASUT,"VOU")
+19 WRITE ?66,ASUT("TRCD"),?69,$JUSTIFY($FNUMBER(ASUC("VAL"),",",2),10)
+20 SET ASUC("LN")=ASUC("LN")+1
+21 SET ASUC("VOU")=ASUC("VOU")+ASUC("VAL")
SET ASUC("VAL")=0
End DoDot:2
IF $DATA(DUOUT)
QUIT
+22 WRITE !
SET ASUC("LN")=ASUC("LN")+1
End DoDot:1
IF $DATA(DUOUT)
QUIT
+23 WRITE !?11,"TOTAL FOR USER ",?35,ASUL(20,"REQ"),?39,ASUL(19,"USR","NM"),?69,$JUSTIFY($FNUMBER(ASUC("VOU"),",",2),10),!
+24 SET ASUC("USR")=ASUC("USR")+ASUC("VOU")
SET ASUC("VOU")=0
+1 SET ASUF("HDR")=0
+2 SET ASUC("PG")=$GET(ASUC("PG"))+1
IF ASUC("PG")>1
DO PAZ^ASUURHDR
IF $DATA(DUOUT)
QUIT
WRITE @IOF
+3 WRITE "REPORT #83 MONTHLY INVOICE SUMMARY REPORT",?51,"DATE: ",$GET(ASUK("DT")),?69,"PAGE :",$JUSTIFY(ASUC("PG"),5)
+4 WRITE !!,"CHARGED TO: AREA : ",?19,ASUL(1,"AR","AP")," ",$GET(ASUL(1,"AR","NM"))
+5 IF '$DATA(ASUL(18,"SST"))
DO SST^ASULDIRR(ASUT(ASUT,"PT","SST"))
+6 WRITE !?13,"FAC : ",ASUL(18,"SST")," ",ASUL(18,"SST","NM")
+7 WRITE ?45,"AS OF MONTH: ",$GET(ASUX("AO MO"))
+8 WRITE !!,"SUB",?55,"INVOICE"
+9 WRITE !,"SUB",?35,"USER",?55,"VOUCHER",?66,"P/"
+10 WRITE !,"ACT-NAME",?27,"CAN",?35,"CODE-NAME",?55,"NUMBER",?67,"C",?74,"VALUE",!
+11 SET ASUC("LN")=8
HDR ;
+1 QUIT
CMPT ;EP ;COMPUTE EXTRACTS
+1 KILL ^XTMP("ASUR","R83")
SET ASUT="ISS"
+2 SET ^XTMP("ASUR","R83",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
+3 FOR ASUC("TR")=1:1
SET ASUHDA=$ORDER(^ASUH("AX",ASUV("R83DT"),$GET(ASUHDA)))
IF ASUHDA=""
QUIT
IF ASUHDA'?1N.N
QUIT
Begin DoDot:1
+4 ;S $P(^ASUH(ASUHDA,0),U,5)=ASUK("DT","FM")
+5 SET ASUT("TRCD")=$PIECE(^ASUH(ASUHDA,1),U)
IF $EXTRACT(ASUT("TRCD"))'=3
QUIT
+6 IF "3132333K3L"'[ASUT("TRCD")
QUIT
+7 DO READ^ASU0TRRD(.ASUHDA,"H")
IF $GET(ASUT)']""
QUIT
+8 IF $EXTRACT(ASUT(ASUT,"CAN"),2,3)'=ASUL(1,"AR","AP")
QUIT
+9 IF ASUT(ASUT,"PT","SST")']""
Begin DoDot:2
+10 DO SST^ASULDIRR(ASUT(ASUT,"SST"))
+11 SET ASUT(ASUT,"PT","SST")=ASUL(18,"SST","E#")
End DoDot:2
+12 IF ASUT(ASUT,"PT","USR")']""
Begin DoDot:2
+13 DO USR^ASULDIRR(ASUT(ASUT,"USR"))
+14 SET ASUT(ASUT,"PT","USR")=ASUL(19,"USR","E#")
End DoDot:2
+15 IF ASUT(ASUT,"PT","SST")']""
Begin DoDot:2
+16 DO SSA^ASULDIRR(ASUT(ASUT,"SSA"))
+17 SET ASUT(ASUT,"PT","SSA")=ASUL(17,"SSA","E#")
End DoDot:2
+18 SET ^XTMP("ASUR","R83",ASUT(ASUT,"PT","SST"),ASUT(ASUT,"PT","SSA"),ASUT(ASUT,"PT","USR"),ASUT(ASUT,"VOU"),ASUT("TRCD"),ASUC("TR"))=ASUT(ASUT,"CAN")_U_ASUT(ASUT,"VAL")
End DoDot:1
+19 KILL ASUT(ASUT)
+20 SET ^XTMP("ASUR","R83",0)=ASUK("DT","FM")_U_ASUK("DT","MONTH")
+21 QUIT
