- 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
