ABMUGTOT.m

ABMUGTOT ; IHS/SD/SDR - 3PB/UFMS Grand Total Report only   

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ; New routine - v2.5 p15

 ;

START ;START HERE

 ; Find the requested UFMS export batch in the UFMS export file.

 ;

BEG ;

 ; Find beginning export batch

 S ABMTRIBL=$P($G(^ABMDPARM(DUZ(2),1,4)),U,14)

 W !

 K DIC,DIE,X,Y,DA

 S DIC="^ABMUTXMT("

 S DIC(0)="AEMQ"

 S DIC("A")="Select beginning export: "

 S ABMSCRND=$P($G(^ABMDPARM(DUZ(2),1,4)),U,16)  ;only show limited entries

 S DIC("S")="S X1=DT,X2=$P(^ABMUTXMT(Y,0),U) D ^%DTC I X<ABMSCRND"

 D ^DIC

 Q:Y<0

 S ABME("XMITB")=+Y

 ;

END ;

 ; Find ending export batch

 W !

 S DIC("A")="Select ending export: "

 D ^DIC

 K DIC

 Q:Y<0

 S ABME("XMITE")=+Y

 I ABME("XMITE")<ABME("XMITB") W !!,"INVALID RANGE!" G BEG

 ;

SUMDET ;summary or detail?

 S ABMSUMDT="G"

 K ABMSAV

 ;

SEL ;

 ; Select device

 S %ZIS="NQ"

 S %ZIS("A")="Enter DEVICE: "

 D ^%ZIS Q:POP

 I IO'=IO(0) D QUE^ABMUVBCH,HOME^%ZIS S DIR(0)="E" D ^DIR K DIR Q

 I $D(IO("S")) S IOP=ION D ^%ZIS

PRINT ;EP

 ; Callable point for queuing

 S ABME("PG")=0

 S ABMP("XMIT")=ABME("XMITB")-1

 D SET^ABMUVBCH  Q:(IOST["C")&(($G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))

 W !!,$$EN^ABMVDF("HIN"),"E N D   O F   R E P O R T",$$EN^ABMVDF("HIF"),!

 I $E(IOST)="C" S DIR(0)="E" D ^DIR K DIR

 I $E(IOST)="P" W $$EN^ABMVDF("IOF")

 I $D(IO("S")) D ^%ZISC

 K ABME

 Q

ABMUGTOT  ; IHS/SD/SDR - 3PB/UFMS Grand Total Report only   

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ; New routine - v2.5 p15

 +3       ;

START     ;START HERE

 +1       ; Find the requested UFMS export batch in the UFMS export file.

 +2       ;

BEG       ;

 +1       ; Find beginning export batch

 +2        SET ABMTRIBL=$PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,14)

 +3        WRITE !

 +4        KILL DIC,DIE,X,Y,DA

 +5        SET DIC="^ABMUTXMT("

 +6        SET DIC(0)="AEMQ"

 +7        SET DIC("A")="Select beginning export: "

 +8       ;only show limited entries

           SET ABMSCRND=$PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,16)

 +9        SET DIC("S")="S X1=DT,X2=$P(^ABMUTXMT(Y,0),U) D ^%DTC I X<ABMSCRND"

 +10       DO ^DIC

 +11       IF Y<0

               QUIT 

 +12       SET ABME("XMITB")=+Y

 +13      ;

END       ;

 +1       ; Find ending export batch

 +2        WRITE !

 +3        SET DIC("A")="Select ending export: "

 +4        DO ^DIC

 +5        KILL DIC

 +6        IF Y<0

               QUIT 

 +7        SET ABME("XMITE")=+Y

 +8        IF ABME("XMITE")<ABME("XMITB")

               WRITE !!,"INVALID RANGE!"

               GOTO BEG

 +9       ;

SUMDET    ;summary or detail?

 +1        SET ABMSUMDT="G"

 +2        KILL ABMSAV

 +3       ;

SEL       ;

 +1       ; Select device

 +2        SET %ZIS="NQ"

 +3        SET %ZIS("A")="Enter DEVICE: "

 +4        DO ^%ZIS

           IF POP

               QUIT 

 +5        IF IO'=IO(0)

               DO QUE^ABMUVBCH

               DO HOME^%ZIS

               SET DIR(0)="E"

               DO ^DIR

               KILL DIR

               QUIT 

 +6        IF $DATA(IO("S"))

               SET IOP=ION

               DO ^%ZIS

PRINT     ;EP

 +1       ; Callable point for queuing

 +2        SET ABME("PG")=0

 +3        SET ABMP("XMIT")=ABME("XMITB")-1

 +4        DO SET^ABMUVBCH

           IF (IOST["C")&(($GET(Y)=0)!($DATA(DIRUT)!$DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)))

               QUIT 

 +5        WRITE !!,$$EN^ABMVDF("HIN"),"E N D   O F   R E P O R T",$$EN^ABMVDF("HIF"),!

 +6        IF $EXTRACT(IOST)="C"

               SET DIR(0)="E"

               DO ^DIR

               KILL DIR

 +7        IF $EXTRACT(IOST)="P"

               WRITE $$EN^ABMVDF("IOF")

 +8        IF $DATA(IO("S"))

               DO ^%ZISC

 +9        KILL ABME

 +10       QUIT