- ASURD09P ; IHS/ITSC/LMH -RPT 9 STA MAST REC CHGS TRANS ;
- ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- ;This routine formats and prints report 9, Station Change/Delete
- ;Transaction List.
- EN ;EP;PRIMARY ENTRY POINT FOR REPORT 09
- 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^ASURD09P",ZTDESC="SAMS RPT 09" D O^ASUUZIS
- I POP S IOP=$I D ^%ZIS Q
- I ASUK(ASUK("PTR"),"Q") Q
- PSER ;EP;FOR TASKMAN QUEUE OF PRINT
- D:'$D(^XTMP("ASUR","R09")) CMPT
- D U^ASUUZIS
- S ASUV("RPT")="R09",ASUQ("HDR")="HEADER^ASURD09P"
- D ^ASUUDATA I ASUX("NDTA") G K
- S (ASUX("IX"),ASUX("SQ"))="",ASUC("TOT")=0
- F S ASUX("AS")=$O(^XTMP("ASUR","R09",ASUX("AS"))) Q:ASUX("AS")="" D Q:$D(DUOUT)
- .I ASUV("ARST")'=ASUX("AS") D HEADER Q:$D(DUOUT)
- .S ASUV("ARST")=ASUX("AS")
- .F S ASUX("IX")=$O(^XTMP("ASUR","R09",ASUX("AS"),ASUX("IX"))) Q:ASUX("IX")="" D Q:$D(DUOUT)
- ..F S ASUX("SQ")=$O(^XTMP("ASUR","R09",ASUX("AS"),ASUX("IX"),ASUX("SQ"))) Q:ASUX("SQ")="" D Q:$D(DUOUT)
- ...S ASUHDA=^XTMP("ASUR","R09",ASUX("AS"),ASUX("IX"),ASUX("SQ"))
- ...D READ^ASU0TRRD(.ASUHDA,"H") Q:$G(ASUT)']""
- ...I ASUC("LN")>(IOSL-2) D HEADER Q:$D(DUOUT)
- ...S ASUV("VAL")=ASUT(ASUT,"UCS"),ASUC("TOT")=ASUC("TOT")+1
- ...W !?1,$E(ASUT(ASUT,"DTS"),2,3),"-",$E(ASUT(ASUT,"DTS"),4,5)
- ...S ASUC("LN")=ASUC("LN")+1
- ...W ?8,ASUT("TRCD"),?13,ASUT(ASUT,"SLC")
- ...W:ASUT(ASUT,"RPQ")]"" ?16,$J($FN(ASUT(ASUT,"RPQ"),",",0),6)
- ...W:ASUV("VAL")]"" ?23,$J($FN(ASUV("VAL"),",",2),12)
- ...W ?36,ASUT(ASUT,"EOQ TYP")
- ...W:ASUT(ASUT,"EOQ MM")]"" ?40,$J($FN(ASUT(ASUT,"EOQ MM"),",",0),5)
- ...W:ASUT(ASUT,"EOQ QM")]"" ?47,$J($FN(ASUT(ASUT,"EOQ QM"),",",0),5)
- ...W ?54,$E(ASUT(ASUT,"EOQ AM")),?56,$E(ASUT(ASUT,"EOQ AM"),2,2)
- ...W ?58,$E(ASUT(ASUT,"EOQ AM"),3,3),?60,$E(ASUT(ASUT,"EOQ AM"),4,5)
- ...W ?65,$E(ASUT(ASUT,"IDX"),1,5),".",$E(ASUT(ASUT,"IDX"),6,6)
- ...S X=ASUT(ASUT,"ORD#")
- ...I X]"",X'=" ",$E(X)'="M" D
- ....W ?74,$E(X,1,4),"-",$E(X,5,6),"-",$E(X,7,9),"-",$E(X,10,14)
- ...E D
- ....W ?74,X
- ...W ?93,ASUT(ASUT,"VEN NM")
- ...W ?110,ASUT(ASUT,"SRC"),?114
- ...S X=ASUT(ASUT,"LTM") I $L(X)>0 W $FN(X,"-",1)
- ...W ?119,ASUT(ASUT,"SUI")
- ...W:ASUT(ASUT,"SPQ")]"" ?125,$J($FN(ASUT(ASUT,"SPQ"),",",0),6)
- W !!?2,"NUMBER LINE ITEMS: ",ASUC("TOT"),!!
- K ;
- K ASUX,ASUV,ASUC,ASUQ,ASUL(2)
- D PAZ^ASUURHDR
- I ASUK("PTRSEL")]"" W @IOF Q
- D C^ASUUZIS
- Q
- CMPT ;EP;COMPUTE REPORT CONTENTS
- K ^XTMP("ASUR","R09") S ^XTMP("ASUR","R09",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
- D:$G(ASUN("TYP"))']"" ^ASUURANG S ASUV("DA")=ASUHDA
- E S (ASUV("DA"),ASUHDA)=ASUN("B#")-1
- S Z="5C" D LOOP S ASUHDA=ASUV("DA"),Z="5D" 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","R09",ASUT(ASUT,"PT","STA"),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 #9. STATION MASTER RECORD CHANGES 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")
- I ASUX("AS")'=$G(ASUL(2,"STA","E#")) D STA^ASULARST(ASUX("AS"))
- W !?3,"STATION: ",$G(ASUL(2,"STA","CD"))
- W ?15,$G(ASUL(2,"STA","NM"))
- W !!?1,"DATE",?7,"TRAN",?12,"SLC",?17,"REVIEW",?30,"UNIT",?36,"EOQ",?42,"EOQ",?49,"EOQ",?54,"EOQ ACTION"
- W ?66,"INDEX",?76,"ORDER",?93,"VENDOR",?108,"SOUR",?113,"LEAD",?119,"SOU",?124,"STANDARD"
- W !?1,"FYMM",?7,"CODE",?17,"POINT",?30,"COST",?36,"TYP",?42,"MON",?49,"QTY",?54,"MONTHS MOD"
- W ?66,"NUMBER",?76,"NUMBER",?93,"NAME",?108,"CODE",?113,"TIME",?119,"U.I",?124,"PACK QTY"
- W !?54,"1Q2Q3Q4Q"
- W !,"------------------------------------------------------------------------------------------------------------------------------------",!
- S ASUC("LN")=9
- Q
- ASURD09P ; IHS/ITSC/LMH -RPT 9 STA MAST REC CHGS TRANS ;
- +1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- +2 ;This routine formats and prints report 9, Station Change/Delete
- +3 ;Transaction List.
- EN ;EP;PRIMARY ENTRY POINT FOR REPORT 09
- +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^ASURD09P"
- SET ZTDESC="SAMS RPT 09"
- 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 IF '$DATA(^XTMP("ASUR","R09"))
- DO CMPT
- +2 DO U^ASUUZIS
- +3 SET ASUV("RPT")="R09"
- SET ASUQ("HDR")="HEADER^ASURD09P"
- +4 DO ^ASUUDATA
- IF ASUX("NDTA")
- GOTO K
- +5 SET (ASUX("IX"),ASUX("SQ"))=""
- SET ASUC("TOT")=0
- +6 FOR
- SET ASUX("AS")=$ORDER(^XTMP("ASUR","R09",ASUX("AS")))
- IF ASUX("AS")=""
- QUIT
- Begin DoDot:1
- +7 IF ASUV("ARST")'=ASUX("AS")
- DO HEADER
- IF $DATA(DUOUT)
- QUIT
- +8 SET ASUV("ARST")=ASUX("AS")
- +9 FOR
- SET ASUX("IX")=$ORDER(^XTMP("ASUR","R09",ASUX("AS"),ASUX("IX")))
- IF ASUX("IX")=""
- QUIT
- Begin DoDot:2
- +10 FOR
- SET ASUX("SQ")=$ORDER(^XTMP("ASUR","R09",ASUX("AS"),ASUX("IX"),ASUX("SQ")))
- IF ASUX("SQ")=""
- QUIT
- Begin DoDot:3
- +11 SET ASUHDA=^XTMP("ASUR","R09",ASUX("AS"),ASUX("IX"),ASUX("SQ"))
- +12 DO READ^ASU0TRRD(.ASUHDA,"H")
- IF $GET(ASUT)']""
- QUIT
- +13 IF ASUC("LN")>(IOSL-2)
- DO HEADER
- IF $DATA(DUOUT)
- QUIT
- +14 SET ASUV("VAL")=ASUT(ASUT,"UCS")
- SET ASUC("TOT")=ASUC("TOT")+1
- +15 WRITE !?1,$EXTRACT(ASUT(ASUT,"DTS"),2,3),"-",$EXTRACT(ASUT(ASUT,"DTS"),4,5)
- +16 SET ASUC("LN")=ASUC("LN")+1
- +17 WRITE ?8,ASUT("TRCD"),?13,ASUT(ASUT,"SLC")
- +18 IF ASUT(ASUT,"RPQ")]""
- WRITE ?16,$JUSTIFY($FNUMBER(ASUT(ASUT,"RPQ"),",",0),6)
- +19 IF ASUV("VAL")]""
- WRITE ?23,$JUSTIFY($FNUMBER(ASUV("VAL"),",",2),12)
- +20 WRITE ?36,ASUT(ASUT,"EOQ TYP")
- +21 IF ASUT(ASUT,"EOQ MM")]""
- WRITE ?40,$JUSTIFY($FNUMBER(ASUT(ASUT,"EOQ MM"),",",0),5)
- +22 IF ASUT(ASUT,"EOQ QM")]""
- WRITE ?47,$JUSTIFY($FNUMBER(ASUT(ASUT,"EOQ QM"),",",0),5)
- +23 WRITE ?54,$EXTRACT(ASUT(ASUT,"EOQ AM")),?56,$EXTRACT(ASUT(ASUT,"EOQ AM"),2,2)
- +24 WRITE ?58,$EXTRACT(ASUT(ASUT,"EOQ AM"),3,3),?60,$EXTRACT(ASUT(ASUT,"EOQ AM"),4,5)
- +25 WRITE ?65,$EXTRACT(ASUT(ASUT,"IDX"),1,5),".",$EXTRACT(ASUT(ASUT,"IDX"),6,6)
- +26 SET X=ASUT(ASUT,"ORD#")
- +27 IF X]""
- IF X'=" "
- IF $EXTRACT(X)'="M"
- Begin DoDot:4
- +28 WRITE ?74,$EXTRACT(X,1,4),"-",$EXTRACT(X,5,6),"-",$EXTRACT(X,7,9),"-",$EXTRACT(X,10,14)
- End DoDot:4
- +29 IF '$TEST
- Begin DoDot:4
- +30 WRITE ?74,X
- End DoDot:4
- +31 WRITE ?93,ASUT(ASUT,"VEN NM")
- +32 WRITE ?110,ASUT(ASUT,"SRC"),?114
- +33 SET X=ASUT(ASUT,"LTM")
- IF $LENGTH(X)>0
- WRITE $FNUMBER(X,"-",1)
- +34 WRITE ?119,ASUT(ASUT,"SUI")
- +35 IF ASUT(ASUT,"SPQ")]""
- WRITE ?125,$JUSTIFY($FNUMBER(ASUT(ASUT,"SPQ"),",",0),6)
- End DoDot:3
- IF $DATA(DUOUT)
- QUIT
- End DoDot:2
- IF $DATA(DUOUT)
- QUIT
- End DoDot:1
- IF $DATA(DUOUT)
- QUIT
- +36 WRITE !!?2,"NUMBER LINE ITEMS: ",ASUC("TOT"),!!
- K ;
- +1 KILL ASUX,ASUV,ASUC,ASUQ,ASUL(2)
- +2 DO PAZ^ASUURHDR
- +3 IF ASUK("PTRSEL")]""
- WRITE @IOF
- QUIT
- +4 DO C^ASUUZIS
- +5 QUIT
- CMPT ;EP;COMPUTE REPORT CONTENTS
- +1 KILL ^XTMP("ASUR","R09")
- SET ^XTMP("ASUR","R09",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
- +2 IF $GET(ASUN("TYP"))']""
- DO ^ASUURANG
- SET ASUV("DA")=ASUHDA
- +3 IF '$TEST
- SET (ASUV("DA"),ASUHDA)=ASUN("B#")-1
- +4 SET Z="5C"
- DO LOOP
- SET ASUHDA=ASUV("DA")
- SET Z="5D"
- 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
- IF $PIECE(ASUT(ASUT,"TRKY"),"-")'=ASUL(2,"STA","E#")
- QUIT
- +3 SET ^XTMP("ASUR","R09",ASUT(ASUT,"PT","STA"),ASUT(ASUT,"PT","IDX"),ASUHDA)=ASUHDA
- End DoDot:1
- +4 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 #9. STATION MASTER RECORD CHANGES 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 IF ASUX("AS")'=$GET(ASUL(2,"STA","E#"))
- DO STA^ASULARST(ASUX("AS"))
- +8 WRITE !?3,"STATION: ",$GET(ASUL(2,"STA","CD"))
- +9 WRITE ?15,$GET(ASUL(2,"STA","NM"))
- +10 WRITE !!?1,"DATE",?7,"TRAN",?12,"SLC",?17,"REVIEW",?30,"UNIT",?36,"EOQ",?42,"EOQ",?49,"EOQ",?54,"EOQ ACTION"
- +11 WRITE ?66,"INDEX",?76,"ORDER",?93,"VENDOR",?108,"SOUR",?113,"LEAD",?119,"SOU",?124,"STANDARD"
- +12 WRITE !?1,"FYMM",?7,"CODE",?17,"POINT",?30,"COST",?36,"TYP",?42,"MON",?49,"QTY",?54,"MONTHS MOD"
- +13 WRITE ?66,"NUMBER",?76,"NUMBER",?93,"NAME",?108,"CODE",?113,"TIME",?119,"U.I",?124,"PACK QTY"
- +14 WRITE !?54,"1Q2Q3Q4Q"
- +15 WRITE !,"------------------------------------------------------------------------------------------------------------------------------------",!
- +16 SET ASUC("LN")=9
- +17 QUIT
