- ASURD08P ; IHS/ITSC/LMH -RPT 8 IDX MAST REC CHGS/DELS ;
- ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- ;This routine formats and prints report 8, Index Change/Delete
- EN ;EP;PRIMARY ENTRY POINT FOR REPORT 08
- I '$D(IO) D HOME^%ZIS
- I '$D(DUZ(2)) W !,"Report must be run from Kernel option" Q
- I '$D(ASUL(1,"AR","AP")) D SETAREA^ASULARST
- S ASUK("PTRSEL")=$G(ASUK("PTRSEL")) I ASUK("PTRSEL")]"" G PSER
- S ZTRTN="PSER^ASURD08P",ZTDESC="SAMS RPT 08" D O^ASUUZIS
- I POP S IOP=$I D ^%ZIS Q
- I ASUK(ASUK("PTR"),"Q") Q
- PSER ;EP;FOR TASKMAN QUEUE OF PRINT
- S ASUT="IDX"
- D:'$D(^XTMP("ASUR","R08")) CMPT
- D U^ASUUZIS
- S ASUV("RPT")="R08",ASUQ("HDR")="HEADER^ASURD08P"
- D ^ASUUDATA I ASUX("NDTA") G K
- S ASUX("IX")=0
- S ASUX("SQ")=""
- S ASUC("TOT")=0
- F S ASUX("IX")=$O(^XTMP("ASUR","R08",ASUX("IX"))) Q:ASUX("IX")="" D Q:$D(DUOUT)
- .I $G(ASUV("AR"))'=$E(ASUX("IX"),1,2) S ASUV("AR")=$E(ASUX("IX"),1,2) D HEADER Q:$D(DUOUT)
- .F S ASUX("SQ")=$O(^XTMP("ASUR","R08",ASUX("IX"),ASUX("SQ"))) Q:ASUX("SQ")="" D Q:$D(DUOUT)
- ..S ASUHDA=^XTMP("ASUR","R08",ASUX("IX"),ASUX("SQ"))
- ..D READ^ASU0TRRD(.ASUHDA,"H") Q:$G(ASUT)']""
- ..I $G(ASUC("LN"))>IOSL D HEADER Q:$D(DUOUT)
- ..S ASUC("TOT")=ASUC("TOT")+1
- ..W ! S X=ASUT(ASUT,"DTS")
- ..S ASUC("LN")=$G(ASUC("LN"))+1
- ..I $L(X)>0 W ?1,$E(X,2,3),"-",$E(X,4,5)
- ..W ?11,ASUT("TRCD"),?16,$E(ASUT(ASUT,"DESC"),1,30),?48,ASUT(ASUT,"AR U/I")
- ..S X=ASUT(ASUT,"IDX")
- ..I $L(X)>0 W ?53,$E(X,1,5),".",$E(X,6,6)
- ..W ?62,ASUT(ASUT,"AR"),?69,ASUT(ASUT,"ACC"),?76,ASUT(ASUT,"SOBJ"),?84,ASUT(ASUT,"CAT")
- ..S X=ASUT(ASUT,"NSN")
- ..I $L(X)>0 W ?91,$E(X,1,4)
- ..I $L(X)>4 W "-",$E(X,5,6),"-",$E(X,7,9),"-",$E(X,10,13)
- ..W !?16,$E(ASUT(ASUT,"DESC"),31,60)
- ..S ASUC("LN")=ASUC("LN")+1
- W !!?2,"NUMBER LINE ITEMS: ",ASUC("TOT"),!!
- K ;
- D PAZ^ASUURHDR
- K ASUX,ASUV,ASUC,ASUQ
- I ASUK("PTRSEL")]"" W @IOF Q
- D C^ASUUZIS
- Q
- CMPT ;EP;COMPUTE REPORT CONTENTS
- K ^XTMP("ASUR","R08") S ^XTMP("ASUR","R08",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM") N Z
- D:$G(ASUN("TYP"))']"" ^ASUURANG
- S (ASUV("DA"),ASUHDA)=ASUN("B#")-1
- S Z="4C" D LOOP S ASUHDA=ASUV("DA"),Z="4D" D LOOP
- Q
- LOOP ;
- F S ASUHDA=$O(^ASUH("T",Z,ASUHDA)) Q:ASUHDA>$G(ASUN("E#")) Q:ASUHDA']"" D
- .D READ^ASU0TRRD(.ASUHDA,"H") Q:$G(ASUT)']""
- .Q:$P(ASUT(ASUT,"TRKY"),"-")'=ASUL(2,"STA","E#")
- .S ^XTMP("ASUR","R08",ASUT(ASUT,"PT","IDX"),ASUHDA)=ASUHDA
- Q
- S ASUC("PG")=$G(ASUC("PG"))+1
- I ASUC("PG")>1 D PAZ^ASUURHDR Q:$D(DUOUT) W @IOF
- W !?5,"REPORT #8. INDEX MASTER RECORD CHANGES/DELETES TRANSACTIONS"
- W ?100,"DATE: ",ASUX("DT"),?120,"PAGE: ",ASUC("PG")
- S X=ASUL(1,"AR","AP") W !?3,"AREA: ",ASUL(1,"AR","AP")
- W ?15,ASUL(1,"AR","NM")
- W !!?2,"DATE",?10,"TRAN",?16,"DESCRIPTION",?46,"UNIT",?54,"INDEX",?61,"AREA",?67,"ACCOUNT",?75,"OBJECT",?84,"CATM",?92,"NATIONAL"
- W !?2,"FYMM",?10,"CODE",?46,"ISSUE",?53,"NUMBER",?61,"CODE",?75,"SUB-OBJ",?84,"CODE",?92,"STOCK NUMBER"
- W !,"------------------------------------------------------------------------------------------------------------------------------------",!!
- S ASUC("LN")=10
- Q
- ASURD08P ; IHS/ITSC/LMH -RPT 8 IDX MAST REC CHGS/DELS ;
- +1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- +2 ;This routine formats and prints report 8, Index Change/Delete
- EN ;EP;PRIMARY ENTRY POINT FOR REPORT 08
- +1 IF '$DATA(IO)
- DO HOME^%ZIS
- +2 IF '$DATA(DUZ(2))
- WRITE !,"Report must be run from Kernel option"
- QUIT
- +3 IF '$DATA(ASUL(1,"AR","AP"))
- DO SETAREA^ASULARST
- +4 SET ASUK("PTRSEL")=$GET(ASUK("PTRSEL"))
- IF ASUK("PTRSEL")]""
- GOTO PSER
- +5 SET ZTRTN="PSER^ASURD08P"
- SET ZTDESC="SAMS RPT 08"
- DO O^ASUUZIS
- +6 IF POP
- SET IOP=$IO
- DO ^%ZIS
- QUIT
- +7 IF ASUK(ASUK("PTR"),"Q")
- QUIT
- PSER ;EP;FOR TASKMAN QUEUE OF PRINT
- +1 SET ASUT="IDX"
- +2 IF '$DATA(^XTMP("ASUR","R08"))
- DO CMPT
- +3 DO U^ASUUZIS
- +4 SET ASUV("RPT")="R08"
- SET ASUQ("HDR")="HEADER^ASURD08P"
- +5 DO ^ASUUDATA
- IF ASUX("NDTA")
- GOTO K
- +6 SET ASUX("IX")=0
- +7 SET ASUX("SQ")=""
- +8 SET ASUC("TOT")=0
- +9 FOR
- SET ASUX("IX")=$ORDER(^XTMP("ASUR","R08",ASUX("IX")))
- IF ASUX("IX")=""
- QUIT
- Begin DoDot:1
- +10 IF $GET(ASUV("AR"))'=$EXTRACT(ASUX("IX"),1,2)
- SET ASUV("AR")=$EXTRACT(ASUX("IX"),1,2)
- DO HEADER
- IF $DATA(DUOUT)
- QUIT
- +11 FOR
- SET ASUX("SQ")=$ORDER(^XTMP("ASUR","R08",ASUX("IX"),ASUX("SQ")))
- IF ASUX("SQ")=""
- QUIT
- Begin DoDot:2
- +12 SET ASUHDA=^XTMP("ASUR","R08",ASUX("IX"),ASUX("SQ"))
- +13 DO READ^ASU0TRRD(.ASUHDA,"H")
- IF $GET(ASUT)']""
- QUIT
- +14 IF $GET(ASUC("LN"))>IOSL
- DO HEADER
- IF $DATA(DUOUT)
- QUIT
- +15 SET ASUC("TOT")=ASUC("TOT")+1
- +16 WRITE !
- SET X=ASUT(ASUT,"DTS")
- +17 SET ASUC("LN")=$GET(ASUC("LN"))+1
- +18 IF $LENGTH(X)>0
- WRITE ?1,$EXTRACT(X,2,3),"-",$EXTRACT(X,4,5)
- +19 WRITE ?11,ASUT("TRCD"),?16,$EXTRACT(ASUT(ASUT,"DESC"),1,30),?48,ASUT(ASUT,"AR U/I")
- +20 SET X=ASUT(ASUT,"IDX")
- +21 IF $LENGTH(X)>0
- WRITE ?53,$EXTRACT(X,1,5),".",$EXTRACT(X,6,6)
- +22 WRITE ?62,ASUT(ASUT,"AR"),?69,ASUT(ASUT,"ACC"),?76,ASUT(ASUT,"SOBJ"),?84,ASUT(ASUT,"CAT")
- +23 SET X=ASUT(ASUT,"NSN")
- +24 IF $LENGTH(X)>0
- WRITE ?91,$EXTRACT(X,1,4)
- +25 IF $LENGTH(X)>4
- WRITE "-",$EXTRACT(X,5,6),"-",$EXTRACT(X,7,9),"-",$EXTRACT(X,10,13)
- +26 WRITE !?16,$EXTRACT(ASUT(ASUT,"DESC"),31,60)
- +27 SET ASUC("LN")=ASUC("LN")+1
- End DoDot:2
- IF $DATA(DUOUT)
- QUIT
- End DoDot:1
- IF $DATA(DUOUT)
- QUIT
- +28 WRITE !!?2,"NUMBER LINE ITEMS: ",ASUC("TOT"),!!
- K ;
- +1 DO PAZ^ASUURHDR
- +2 KILL ASUX,ASUV,ASUC,ASUQ
- +3 IF ASUK("PTRSEL")]""
- WRITE @IOF
- QUIT
- +4 DO C^ASUUZIS
- +5 QUIT
- CMPT ;EP;COMPUTE REPORT CONTENTS
- +1 KILL ^XTMP("ASUR","R08")
- SET ^XTMP("ASUR","R08",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
- NEW Z
- +2 IF $GET(ASUN("TYP"))']""
- DO ^ASUURANG
- +3 SET (ASUV("DA"),ASUHDA)=ASUN("B#")-1
- +4 SET Z="4C"
- DO LOOP
- SET ASUHDA=ASUV("DA")
- SET Z="4D"
- DO LOOP
- +5 QUIT
- LOOP ;
- +1 FOR
- SET ASUHDA=$ORDER(^ASUH("T",Z,ASUHDA))
- IF ASUHDA>$GET(ASUN("E#"))
- QUIT
- IF ASUHDA']""
- QUIT
- Begin DoDot:1
- +2 DO READ^ASU0TRRD(.ASUHDA,"H")
- IF $GET(ASUT)']""
- QUIT
- +3 IF $PIECE(ASUT(ASUT,"TRKY"),"-")'=ASUL(2,"STA","E#")
- QUIT
- +4 SET ^XTMP("ASUR","R08",ASUT(ASUT,"PT","IDX"),ASUHDA)=ASUHDA
- End DoDot:1
- +5 QUIT
- +1 SET ASUC("PG")=$GET(ASUC("PG"))+1
- +2 IF ASUC("PG")>1
- DO PAZ^ASUURHDR
- IF $DATA(DUOUT)
- QUIT
- WRITE @IOF
- +3 WRITE !?5,"REPORT #8. INDEX MASTER RECORD CHANGES/DELETES TRANSACTIONS"
- +4 WRITE ?100,"DATE: ",ASUX("DT"),?120,"PAGE: ",ASUC("PG")
- +5 SET X=ASUL(1,"AR","AP")
- WRITE !?3,"AREA: ",ASUL(1,"AR","AP")
- +6 WRITE ?15,ASUL(1,"AR","NM")
- +7 WRITE !!?2,"DATE",?10,"TRAN",?16,"DESCRIPTION",?46,"UNIT",?54,"INDEX",?61,"AREA",?67,"ACCOUNT",?75,"OBJECT",?84,"CATM",?92,"NATIONAL"
- +8 WRITE !?2,"FYMM",?10,"CODE",?46,"ISSUE",?53,"NUMBER",?61,"CODE",?75,"SUB-OBJ",?84,"CODE",?92,"STOCK NUMBER"
- +9 WRITE !,"------------------------------------------------------------------------------------------------------------------------------------",!!
- +10 SET ASUC("LN")=10
- +11 QUIT
