- 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