ASURD72P.m

ASURD72P ; IHS/ITSC/LMH -RPT 72 UNDELVRD PO FOLLOW UP ; 

 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000

 ;This routine formats and prints report 72, Undelivered Purchase Order

 ;Followup Report.

STANDARD ;EP; FOR STANDARD PRINT

 Q  ;WAR 5/21/99

 ;K ^XTMP("ASUR","R72") ;B:$G(JDH)  S ^XTMP("ASUR","R72",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")

START ;

 D DATE^ASUUDATE,TIME^ASUUDATE

 S X=ASUK("DT","FM") D H^%DTC S X3=%H D:'$D(IO) HOME^%ZIS

 I $D(^XTMP("ASUR","R72")) D CMPT

 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^ASURD72P",ZTDESC="SAMS RPT 72" 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 U^ASUUZIS S ASUC("LN")=IOSL+1,(ASUV("D/IPO#"),ASUV("IDX"))=""

 S Y=$P($G(^XTMP("ASUR","R72",0)),U,2) X ^DD("DD") S ASUX("DT")=Y

 S X=$O(^XTMP("ASUR","R72",0)) I X']"" S ASUMS("AR")="" D HEADER Q:$D(DIRUT)  W !,*7,"NO DATA FOR REPORT #72" W ?27,ASUX("DT") G K

 S ASUMS("AR")=$P($G(^ASUMS(X,0)),U,2) I ASUMS("AR")']"" W !,"NO STATION MASTERS LOADED" G K

 S (ASUMS("D/I","PO#"),ASUMX("IDX"))=""

 ;S ASUMS("STA")=$O(^XTMP("ASUR","R72","")) I ASUMS("STA")'>0 G K

 S ASUMS("STA")=$O(^XTMP("ASUR","R72",0)) I ASUMS("STA")'>0 G K ; JDH

 F  S ASUMS("D/I","PO#")=$O(^XTMP("ASUR","R72",ASUMS("STA"),ASUMS("D/I","PO#"))) D  Q:ASUMS("D/I","PO#")=""!$D(DIRUT)

 .S:ASUV("D/IPO#")="" ASUV("D/IPO#")=ASUMS("D/I","PO#") D:ASUV("D/IPO#")'=ASUMS("D/I","PO#")

 ..W !!?1,"FOLLOW UP MADE BY:",?41,"DATE:",!!?1,"STATUS:",!

 ..S ASUC("LN")=IOSL+1,ASUV("D/IPO#")=ASUMS("D/I","PO#")

 .Q:ASUV("D/IPO#")']""

 .F  S ASUMX("IDX")=$O(^XTMP("ASUR","R72",ASUMS("STA"),ASUMS("D/I","PO#"),ASUMX("IDX"))) D  Q:ASUMX("IDX")=""  Q:$D(DIRUT)

 ..S:ASUV("IDX")="" ASUV("IDX")=ASUMX("IDX") D:ASUV("IDX")'=ASUMX("IDX") P2 Q:$D(DIRUT)  Q:ASUMX("IDX")']""  D P1

K ;

 K ASUV,DIC,ASUMX,ASUC,X,X2,X3,Y

 F X=3:1:22 K ASUL(X) ;Clear Table Lookup fields

 D PAZ^ASUURHDR

 I ASUK("PTRSEL")]"" W @IOF Q

 ;D C^ASUUZIS

 Q

REPRINT ;ENTRY TO RECREATE REPORT 72 INCLUDING ITEMS ON LAST PRINT

 I '$D(^ASUR7(72,1,0)) G STANDARD

 S:'$D(ASUV("R72 LAST DT")) ASUV("R72 LAST DT")=^ASUR7(72,1,0)

 G START

P1 ;READ EXTRACT DATA

 S ASUX(0)=^XTMP("ASUR","R72",ASUMS("STA"),ASUMS("D/I","PO#"),ASUMX("IDX"))

 S ASUMS("D/I","DT")=$P(ASUX(0),U,4)

 S ASUMX("DESC",1)=$P(ASUX(0),U,5)

 S ASUMX("DESC",2)=$P(ASUX(0),U,6)

 S ASUMX("AR U/I")=$P(ASUX(0),U,7)

 S ASUMS("D/I","QTY")=$P(ASUX(0),U,8)

 S ASUMS("QTY","O/H")=$P(ASUX(0),U,9)

 S ASUMS("PMIQ")=$P(ASUX(0),U,10)

 S ASUV("PASTDU")=$P(ASUX(0),U,11)

 S ASUMS("LTM")=$P(ASUX(0),U,12)

 Q

P2 ;RPT 72 UNDELVRD PO FOLLOW UP

 I ASUC("LN")>(IOSL-2) D HEADER Q:$D(DIRUT)

 W !!?1,$E(ASUV("IDX"),1,5),".",$E(ASUV("IDX"),6,6)

 W ?10,ASUMX("DESC",1)

 W ?41,ASUMX("AR U/I")

 W ?44,$J($FN(ASUMS("D/I","QTY"),","),7)

 W ?52,$J($FN(ASUMS("QTY","O/H"),","),8)

 W ?60,$J($FN(ASUMS("PMIQ"),","),6)

 W ?67,$J($FN(ASUV("PASTDU"),","),6)

 W ?74,$E(ASUMS("LTM")),".",$E(ASUMS("LTM"),2,2)

 W !?10,ASUMX("DESC",2)

 S ASUC("LN")=ASUC("LN")+3,ASUV("IDX")=ASUMX("IDX")

 Q

HEADER ;

 S ASUC("PG")=$G(ASUC("PG"))+1,ASUC("LN")=0

 D:ASUC("PG")>1 PAZ^ASUURHDR  Q:$D(DIRUT)  W @IOF

 W !?1,"REPORT #72  UNDELIVERED PURCHASE ORDER -FOLLOW UP REPORT" W ?61,ASUX("DT"),?74,"PAGE ",ASUC("PG")

 Q:ASUMS("AR")']""  W !?3,"AREA: ",ASUL(1,"AR","AP"),?15,ASUL(1,"AR","NM")

 ;D STA^ASULARST(ASUMS("STA")) W !?3,"STAT: ",ASUL(2,"STA"),?15,ASUL(2,"STA","NM")

 D STA^ASULARST(ASUMS("STA")) W !?3,"STAT: ",ASUL(2,"STA","E#"),?15,ASUL(2,"STA","NM") ; JDH

 W !?1,"PURCHASE ORDER NO. ",ASUV("D/IPO#")," -",?31,"DELIVERY DUE DATE: " S X=ASUMS("D/I","DT") X ^DD("DD") W ?50,X

 W !!!?49,"DUE     QTY          NO.",!?3,"INDEX",?50,"IN",?58,"ON",?68,"DAYS",?75,"LT",!?2,"NUMBER  DESCRIPTION",?41,"UI",?49,"QTY",?56,"HAND",?62,"PAMIQ",?68,"LATE",?74,"MOS"

 S ASUC("LN")=8 Q

CMPT ;EP ;SORT RPT 72 -XTR ^ASUX

 K ^XTMP("ASUR","R72") S ^XTMP("ASUR","R72",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM") D:'$D(ASUK("DT","FM")) DATE^ASUUDATE,TIME^ASUUDATE

 S X=ASUK("DT","FM") D H^%DTC S X3=%H

 S ASUMS("E#","STA")=0 F  S ASUMS("E#","STA")=$O(^ASUMS(ASUMS("E#","STA"))) Q:ASUMS("E#","STA")'?1N.N  S ASUMS("E#","IDX")=0 D

 .F  S ASUMS("E#","IDX")=$O(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"))) Q:ASUMS("E#","IDX")'?1N.N  D

 ..S ASUV("E#")=ASUMS("E#","IDX") D ^ASUMSTRD

 ..I ASUF("DLIDX") S ASUMS("E#","IDX")=ASUV("E#") Q

 ..S ASUF("DUEIN")=0 F ASUV("DUEIN")=1:1:3 D

 ...Q:ASUMS("D/I","DT",ASUV("DUEIN"))']""  Q:ASUMS("D/I","QTY",ASUV("DUEIN"))']""  Q:ASUMS("D/I","QTY",ASUV("DUEIN"))=0

 ...I ASUF("DUEIN")=0 S ASUMX("E#","IDX")=ASUMS("E#","IDX") D READ^ASUMXDIO S ASUF("DUEIN")=1

 ...S ASUV("DUEDT")=ASUMS("D/I","DT",ASUV("DUEIN")) S X=ASUV("DUEDT") D H^%DTC S X2=%H Q:X2>X3

 ...S ASUV("PASTDU")=X3-X2 Q:ASUV("PASTDU")<0!(ASUV("PASTDU")<7)  S ASUF("RPTD")=0

 ...I ASUMS("D/I","DTR72",ASUV("DUEIN"))?1N.N D

 ....I $D(ASUV("R72 LAST DT")) Q:ASUMS("D/I","DTR72",ASUV("DUEIN"))=ASUV("R72 LAST DT")

 ....S X=$E(ASUMS("D/I","DTR72",ASUV("DUEIN")),1,7) D H^%DTC S X2=%H I X2>X3 S ASUF("RPTD")=1 Q

 ....S ASUV("RPTD")=X3-X2 I ASUV("RPTD")<7 S ASUF("RPTD")=1

 ...; JDH WHAT DOES 7 DAYS HAVE TO DO WITH LATENESS ;Q:ASUF("RPTD")

 ...S ASUMS("D/I","DTR72",ASUV("DUEIN"))=ASUK("DT","FM")

 ...S:ASUMS("D/I","PO#",ASUV("DUEIN"))="" ASUMS("D/I","PO#",ASUV("DUEIN"))=" "

 ...S X=ASUMS("STA")_U_ASUMS("D/I","PO#",ASUV("DUEIN"))_U_ASUMX("IDX")_U_ASUMS("D/I","DT",ASUV("DUEIN"))_U_ASUMX("DESC",1)_U_ASUMX("DESC",2)

 ...S X=X_U_ASUMX("AR U/I")_U_ASUMS("D/I","QTY",ASUV("DUEIN"))_U_ASUMS("QTY","O/H")_U_ASUMS("PMIQ")_U_ASUV("PASTDU")_U_ASUMS("LTM")

 ...S ^XTMP("ASUR","R72",ASUMS("STA"),ASUMS("D/I","PO#",ASUV("DUEIN")),ASUMX("IDX"))=X

 ...K X Q

 ..D:ASUF("DUEIN") ^ASUMSTWR

 K ASUV,ASUF("DUEIN"),ASUF("RPTD"),ASUMX,ASUMS

 Q

ASURD72P  ; IHS/ITSC/LMH -RPT 72 UNDELVRD PO FOLLOW UP ; 

 +1       ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000

 +2       ;This routine formats and prints report 72, Undelivered Purchase Order

 +3       ;Followup Report.

STANDARD  ;EP; FOR STANDARD PRINT

 +1       ;WAR 5/21/99

           QUIT 

 +2       ;K ^XTMP("ASUR","R72") ;B:$G(JDH)  S ^XTMP("ASUR","R72",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")

START     ;

 +1        DO DATE^ASUUDATE

           DO TIME^ASUUDATE

 +2        SET X=ASUK("DT","FM")

           DO H^%DTC

           SET X3=%H

           IF '$DATA(IO)

               DO HOME^%ZIS

 +3        IF $DATA(^XTMP("ASUR","R72"))

               DO CMPT

 +4        IF '$DATA(DUZ(2))

               WRITE !,"Report must be run from Kernel option"

               QUIT 

 +5        IF '$DATA(ASUL(1,"AR","AP"))

               DO SETAREA^ASULARST

 +6        SET ASUK("PTRSEL")=$GET(ASUK("PTRSEL"))

           IF ASUK("PTRSEL")]""

               GOTO PSER

 +7        SET ZTRTN="PSER^ASURD72P"

           SET ZTDESC="SAMS RPT 72"

           DO O^ASUUZIS

 +8        IF POP

               SET IOP=$IO

               DO ^%ZIS

               QUIT 

 +9        IF ASUK(ASUK("PTR"),"Q")

               QUIT 

PSER      ;EP;FOR TASKMAN QUEUE OF PRINT

 +1        DO U^ASUUZIS

           SET ASUC("LN")=IOSL+1

           SET (ASUV("D/IPO#"),ASUV("IDX"))=""

 +2        SET Y=$PIECE($GET(^XTMP("ASUR","R72",0)),U,2)

           XECUTE ^DD("DD")

           SET ASUX("DT")=Y

 +3        SET X=$ORDER(^XTMP("ASUR","R72",0))

           IF X']""

               SET ASUMS("AR")=""

               DO HEADER

               IF $DATA(DIRUT)

                   QUIT 

               WRITE !,*7,"NO DATA FOR REPORT #72"

               WRITE ?27,ASUX("DT")

               GOTO K

 +4        SET ASUMS("AR")=$PIECE($GET(^ASUMS(X,0)),U,2)

           IF ASUMS("AR")']""

               WRITE !,"NO STATION MASTERS LOADED"

               GOTO K

 +5        SET (ASUMS("D/I","PO#"),ASUMX("IDX"))=""

 +6       ;S ASUMS("STA")=$O(^XTMP("ASUR","R72","")) I ASUMS("STA")'>0 G K

 +7       ; JDH

           SET ASUMS("STA")=$ORDER(^XTMP("ASUR","R72",0))

           IF ASUMS("STA")'>0

               GOTO K

 +8        FOR 

               SET ASUMS("D/I","PO#")=$ORDER(^XTMP("ASUR","R72",ASUMS("STA"),ASUMS("D/I","PO#")))

               Begin DoDot:1

 +9                IF ASUV("D/IPO#")=""

                       SET ASUV("D/IPO#")=ASUMS("D/I","PO#")

                   IF ASUV("D/IPO#")'=ASUMS("D/I","PO#")

                       Begin DoDot:2

 +10                       WRITE !!?1,"FOLLOW UP MADE BY:",?41,"DATE:",!!?1,"STATUS:",!

 +11                       SET ASUC("LN")=IOSL+1

                           SET ASUV("D/IPO#")=ASUMS("D/I","PO#")

                       End DoDot:2

 +12               IF ASUV("D/IPO#")']""

                       QUIT 

 +13               FOR 

                       SET ASUMX("IDX")=$ORDER(^XTMP("ASUR","R72",ASUMS("STA"),ASUMS("D/I","PO#"),ASUMX("IDX")))

                       Begin DoDot:2

 +14                       IF ASUV("IDX")=""

                               SET ASUV("IDX")=ASUMX("IDX")

                           IF ASUV("IDX")'=ASUMX("IDX")

                               DO P2

                           IF $DATA(DIRUT)

                               QUIT 

                           IF ASUMX("IDX")']""

                               QUIT 

                           DO P1

                       End DoDot:2

                       IF ASUMX("IDX")=""

                           QUIT 

                       IF $DATA(DIRUT)

                           QUIT 

               End DoDot:1

               IF ASUMS("D/I","PO#")=""!$DATA(DIRUT)

                   QUIT 

K         ;

 +1        KILL ASUV,DIC,ASUMX,ASUC,X,X2,X3,Y

 +2       ;Clear Table Lookup fields

           FOR X=3:1:22

               KILL ASUL(X)

 +3        DO PAZ^ASUURHDR

 +4        IF ASUK("PTRSEL")]""

               WRITE @IOF

               QUIT 

 +5       ;D C^ASUUZIS

 +6        QUIT 

REPRINT   ;ENTRY TO RECREATE REPORT 72 INCLUDING ITEMS ON LAST PRINT

 +1        IF '$DATA(^ASUR7(72,1,0))

               GOTO STANDARD

 +2        IF '$DATA(ASUV("R72 LAST DT"))

               SET ASUV("R72 LAST DT")=^ASUR7(72,1,0)

 +3        GOTO START

P1        ;READ EXTRACT DATA

 +1        SET ASUX(0)=^XTMP("ASUR","R72",ASUMS("STA"),ASUMS("D/I","PO#"),ASUMX("IDX"))

 +2        SET ASUMS("D/I","DT")=$PIECE(ASUX(0),U,4)

 +3        SET ASUMX("DESC",1)=$PIECE(ASUX(0),U,5)

 +4        SET ASUMX("DESC",2)=$PIECE(ASUX(0),U,6)

 +5        SET ASUMX("AR U/I")=$PIECE(ASUX(0),U,7)

 +6        SET ASUMS("D/I","QTY")=$PIECE(ASUX(0),U,8)

 +7        SET ASUMS("QTY","O/H")=$PIECE(ASUX(0),U,9)

 +8        SET ASUMS("PMIQ")=$PIECE(ASUX(0),U,10)

 +9        SET ASUV("PASTDU")=$PIECE(ASUX(0),U,11)

 +10       SET ASUMS("LTM")=$PIECE(ASUX(0),U,12)

 +11       QUIT 

P2        ;RPT 72 UNDELVRD PO FOLLOW UP

 +1        IF ASUC("LN")>(IOSL-2)

               DO HEADER

               IF $DATA(DIRUT)

                   QUIT 

 +2        WRITE !!?1,$EXTRACT(ASUV("IDX"),1,5),".",$EXTRACT(ASUV("IDX"),6,6)

 +3        WRITE ?10,ASUMX("DESC",1)

 +4        WRITE ?41,ASUMX("AR U/I")

 +5        WRITE ?44,$JUSTIFY($FNUMBER(ASUMS("D/I","QTY"),","),7)

 +6        WRITE ?52,$JUSTIFY($FNUMBER(ASUMS("QTY","O/H"),","),8)

 +7        WRITE ?60,$JUSTIFY($FNUMBER(ASUMS("PMIQ"),","),6)

 +8        WRITE ?67,$JUSTIFY($FNUMBER(ASUV("PASTDU"),","),6)

 +9        WRITE ?74,$EXTRACT(ASUMS("LTM")),".",$EXTRACT(ASUMS("LTM"),2,2)

 +10       WRITE !?10,ASUMX("DESC",2)

 +11       SET ASUC("LN")=ASUC("LN")+3

           SET ASUV("IDX")=ASUMX("IDX")

 +12       QUIT 

HEADER    ;

 +1        SET ASUC("PG")=$GET(ASUC("PG"))+1

           SET ASUC("LN")=0

 +2        IF ASUC("PG")>1

               DO PAZ^ASUURHDR

           IF $DATA(DIRUT)

               QUIT 

           WRITE @IOF

 +3        WRITE !?1,"REPORT #72  UNDELIVERED PURCHASE ORDER -FOLLOW UP REPORT"

           WRITE ?61,ASUX("DT"),?74,"PAGE ",ASUC("PG")

 +4        IF ASUMS("AR")']""

               QUIT 

           WRITE !?3,"AREA: ",ASUL(1,"AR","AP"),?15,ASUL(1,"AR","NM")

 +5       ;D STA^ASULARST(ASUMS("STA")) W !?3,"STAT: ",ASUL(2,"STA"),?15,ASUL(2,"STA","NM")

 +6       ; JDH

           DO STA^ASULARST(ASUMS("STA"))

           WRITE !?3,"STAT: ",ASUL(2,"STA","E#"),?15,ASUL(2,"STA","NM")

 +7        WRITE !?1,"PURCHASE ORDER NO. ",ASUV("D/IPO#")," -",?31,"DELIVERY DUE DATE: "

           SET X=ASUMS("D/I","DT")

           XECUTE ^DD("DD")

           WRITE ?50,X

 +8        WRITE !!!?49,"DUE     QTY          NO.",!?3,"INDEX",?50,"IN",?58,"ON",?68,"DAYS",?75,"LT",!?2,"NUMBER  DESCRIPTION",?41,"UI",?49,"QTY",?56,"HAND",?62,"PAMIQ",?68,"LATE",?74,"MOS"

 +9        SET ASUC("LN")=8

           QUIT 

CMPT      ;EP ;SORT RPT 72 -XTR ^ASUX

 +1        KILL ^XTMP("ASUR","R72")

           SET ^XTMP("ASUR","R72",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")

           IF '$DATA(ASUK("DT","FM"))

               DO DATE^ASUUDATE

               DO TIME^ASUUDATE

 +2        SET X=ASUK("DT","FM")

           DO H^%DTC

           SET X3=%H

 +3        SET ASUMS("E#","STA")=0

           FOR 

               SET ASUMS("E#","STA")=$ORDER(^ASUMS(ASUMS("E#","STA")))

               IF ASUMS("E#","STA")'?1N.N

                   QUIT 

               SET ASUMS("E#","IDX")=0

               Begin DoDot:1

 +4                FOR 

                       SET ASUMS("E#","IDX")=$ORDER(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX")))

                       IF ASUMS("E#","IDX")'?1N.N

                           QUIT 

                       Begin DoDot:2

 +5                        SET ASUV("E#")=ASUMS("E#","IDX")

                           DO ^ASUMSTRD

 +6                        IF ASUF("DLIDX")

                               SET ASUMS("E#","IDX")=ASUV("E#")

                               QUIT 

 +7                        SET ASUF("DUEIN")=0

                           FOR ASUV("DUEIN")=1:1:3

                               Begin DoDot:3

 +8                                IF ASUMS("D/I","DT",ASUV("DUEIN"))']""

                                       QUIT 

                                   IF ASUMS("D/I","QTY",ASUV("DUEIN"))']""

                                       QUIT 

                                   IF ASUMS("D/I","QTY",ASUV("DUEIN"))=0

                                       QUIT 

 +9                                IF ASUF("DUEIN")=0

                                       SET ASUMX("E#","IDX")=ASUMS("E#","IDX")

                                       DO READ^ASUMXDIO

                                       SET ASUF("DUEIN")=1

 +10                               SET ASUV("DUEDT")=ASUMS("D/I","DT",ASUV("DUEIN"))

                                   SET X=ASUV("DUEDT")

                                   DO H^%DTC

                                   SET X2=%H

                                   IF X2>X3

                                       QUIT 

 +11                               SET ASUV("PASTDU")=X3-X2

                                   IF ASUV("PASTDU")<0!(ASUV("PASTDU")<7)

                                       QUIT 

                                   SET ASUF("RPTD")=0

 +12                               IF ASUMS("D/I","DTR72",ASUV("DUEIN"))?1N.N

                                       Begin DoDot:4

 +13                                       IF $DATA(ASUV("R72 LAST DT"))

                                               IF ASUMS("D/I","DTR72",ASUV("DUEIN"))=ASUV("R72 LAST DT")

                                                   QUIT 

 +14                                       SET X=$EXTRACT(ASUMS("D/I","DTR72",ASUV("DUEIN")),1,7)

                                           DO H^%DTC

                                           SET X2=%H

                                           IF X2>X3

                                               SET ASUF("RPTD")=1

                                               QUIT 

 +15                                       SET ASUV("RPTD")=X3-X2

                                           IF ASUV("RPTD")<7

                                               SET ASUF("RPTD")=1

                                       End DoDot:4

 +16      ; JDH WHAT DOES 7 DAYS HAVE TO DO WITH LATENESS ;Q:ASUF("RPTD")

 +17                               SET ASUMS("D/I","DTR72",ASUV("DUEIN"))=ASUK("DT","FM")

 +18                               IF ASUMS("D/I","PO#",ASUV("DUEIN"))=""

                                       SET ASUMS("D/I","PO#",ASUV("DUEIN"))=" "

 +19                               SET X=ASUMS("STA")_U_ASUMS("D/I","PO#",ASUV("DUEIN"))_U_ASUMX("IDX")_U_ASUMS("D/I","DT",ASUV("DUEIN"))_U_ASUMX("DESC",1)_U_ASUMX("DESC",2)

 +20                               SET X=X_U_ASUMX("AR U/I")_U_ASUMS("D/I","QTY",ASUV("DUEIN"))_U_ASUMS("QTY","O/H")_U_ASUMS("PMIQ")_U_ASUV("PASTDU")_U_ASUMS("LTM")

 +21                               SET ^XTMP("ASUR","R72",ASUMS("STA"),ASUMS("D/I","PO#",ASUV("DUEIN")),ASUMX("IDX"))=X

 +22                               KILL X

                                   QUIT 

                               End DoDot:3

 +23                       IF ASUF("DUEIN")

                               DO ^ASUMSTWR

                       End DoDot:2

               End DoDot:1

 +24       KILL ASUV,ASUF("DUEIN"),ASUF("RPTD"),ASUMX,ASUMS

 +25       QUIT