- ABMDRUTL ; IHS/ASDST/DMJ - Report Utility ;
- ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- ;Original;TMD;
- ;
- ZIS ;EP for selecting device
- W !!! S %ZIS="PQ",%ZIS("B")="",%ZIS("A")="Output DEVICE: " D ^%ZIS I $G(POP)!'$D(IO) S DUOUT="" Q
- S:ION["HOST" %ZIS("IOPAR")=IOPAR
- S ABM("IOP")=ION_";"_IOST_";"_$S($D(ABM(132)):132,1:80)_";"_IOSL
- I $D(ABM(132)) D ^ABMDR16 Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
- ;
- I $E(IOST)="C"!$D(IO("S"))!$D(IO("Q")) Q
- I $P($G(^ABMDPARM(DUZ(2),1,0)),U,13)="Y" W !!,"As specified in the 3P Site Parameters File FORCED QUEUEING is in effect!",! S IO("Q")=1 Q
- ;
- Q:$D(ABM("FAST"))
- W !!,"NOTE: This report might take considerable time to run, putting a large demand",!,"on the computer processor, which could adversely impact the response time on"
- W !,"other users. Thus, it is recommended that this report be queued to run at a time",!,"of limited activity. Contact your Site Manager for assistance with queueing."
- ;
- W !! K DIR S DIR(0)="Y",DIR("A")="Do you wish to QUE this REPORT (Y/N)",DIR("B")="Y" D ^DIR K DIR I $G(Y) S IO("Q")="" Q
- D WAIT^DICD
- Q
- ;
- PAZ ;EP to pause report
- I '$D(IO("Q")),$E(IOST)="C",'$D(IO("S")) D
- .F W ! Q:$Y+3>IOSL
- .K DIR S DIR(0)="E" D ^DIR K DIR
- Q
- ;
- POUT ;EP for exiting report
- K:$D(ABM("SUBR")) ^TMP(ABM("SUBR"),$J)
- D KILL^%ZTLOAD
- K ABMY,ABMP,ABM,IO("Q"),POP,DIR,DUOUT,DTOUT,ZTSK,DIROUT,DIRUT,%ZIS
- Q
- ;
- QUE ;EP for queuing
- F ABM="DUZ(2)","DUZ(0)","ABM(","ABMY(","ABMP(","%ZIS(" S ZTSAVE(ABM)=""
- D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED! Task Number: ",ZTSK,!
- D ^%ZISC
- K ZTSK,ZTDESC,ZTSAVE,ZTRTN,IO("Q")
- Q
- ;
- LOOP ;EP for Looping thru Bill File
- S ABMP("X")=$S($G(ABMY("DT"))="V":"AD",$G(ABMY("DT"))="A":"AP",$G(ABMY("DT"))="X":"AX",$G(ABMY("DT"))="P":"AE",$D(ABMY("INS")):"AJ",$D(ABMY("PAT")):"D",1:1)
- I ABMP("X") D Q
- .S ABM=0 F S ABM=$O(^ABMDBILL(DUZ(2),ABM)) Q:'ABM D @("DATA^"_ABMP("RTN"))
- I $G(ABMY("DT"))]"","APV"[ABMY("DT") S ABMP("DT")=ABMY("DT",1)-.5 D Q
- .F S ABMP("DT")=$O(^ABMDBILL(DUZ(2),ABMP("X"),ABMP("DT"))) Q:'ABMP("DT")!(ABMP("DT")>(ABMY("DT",2)+.5)) D
- ..S ABM="" F S ABM=$O(^ABMDBILL(DUZ(2),ABMP("X"),ABMP("DT"),ABM)) Q:'ABM D @("DATA^"_ABMP("RTN"))
- I $G(ABMY("DT"))="X" S ABMP("DT")=ABMY("DT",1)-.5 D Q
- .F S ABMP("DT")=$O(^ABMDTXST(DUZ(2),"B",ABMP("DT"))) Q:'ABMP("DT")!(ABMP("DT")>(ABMY("DT",2)+.5)) D
- ..S ABMP("DTD")=0 F S ABMP("DTD")=$O(^ABMDTXST(DUZ(2),"B",ABMP("DT"),ABMP("DTD"))) Q:'ABMP("DTD") D
- ...S ABM=0 F S ABM=$O(^ABMDBILL(DUZ(2),"AX",ABMP("DTD"),ABM)) Q:'ABM D @("DATA^"_ABMP("RTN"))
- S ABMP("DT")=ABMY("DT",1)-1 D
- .S ABM="",ABMP("RI")=$S(ABMP("X")="AJ":ABMY("INS"),1:ABMY("PAT")) F S ABM=$O(^ABMDBILL(DUZ(2),ABMP("X"),ABMP("RI"),ABM)) Q:'ABM D @("DATA^"_ABMP("RTN"))
- Q
- ABMDRUTL ; IHS/ASDST/DMJ - Report Utility ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- +2 ;Original;TMD;
- +3 ;
- ZIS ;EP for selecting device
- +1 WRITE !!!
- SET %ZIS="PQ"
- SET %ZIS("B")=""
- SET %ZIS("A")="Output DEVICE: "
- DO ^%ZIS
- IF $GET(POP)!'$DATA(IO)
- SET DUOUT=""
- QUIT
- +2 IF ION["HOST"
- SET %ZIS("IOPAR")=IOPAR
- +3 SET ABM("IOP")=ION_";"_IOST_";"_$SELECT($DATA(ABM(132)):132,1:80)_";"_IOSL
- +4 IF $DATA(ABM(132))
- DO ^ABMDR16
- IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- QUIT
- +5 ;
- +6 IF $EXTRACT(IOST)="C"!$DATA(IO("S"))!$DATA(IO("Q"))
- QUIT
- +7 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,0)),U,13)="Y"
- WRITE !!,"As specified in the 3P Site Parameters File FORCED QUEUEING is in effect!",!
- SET IO("Q")=1
- QUIT
- +8 ;
- +9 IF $DATA(ABM("FAST"))
- QUIT
- +10 WRITE !!,"NOTE: This report might take considerable time to run, putting a large demand",!,"on the computer processor, which could adversely impact the response time on"
- +11 WRITE !,"other users. Thus, it is recommended that this report be queued to run at a time",!,"of limited activity. Contact your Site Manager for assistance with queueing."
- +12 ;
- +13 WRITE !!
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Do you wish to QUE this REPORT (Y/N)"
- SET DIR("B")="Y"
- DO ^DIR
- KILL DIR
- IF $GET(Y)
- SET IO("Q")=""
- QUIT
- +14 DO WAIT^DICD
- +15 QUIT
- +16 ;
- PAZ ;EP to pause report
- +1 IF '$DATA(IO("Q"))
- IF $EXTRACT(IOST)="C"
- IF '$DATA(IO("S"))
- Begin DoDot:1
- +2 FOR
- WRITE !
- IF $Y+3>IOSL
- QUIT
- +3 KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- End DoDot:1
- +4 QUIT
- +5 ;
- POUT ;EP for exiting report
- +1 IF $DATA(ABM("SUBR"))
- KILL ^TMP(ABM("SUBR"),$JOB)
- +2 DO KILL^%ZTLOAD
- +3 KILL ABMY,ABMP,ABM,IO("Q"),POP,DIR,DUOUT,DTOUT,ZTSK,DIROUT,DIRUT,%ZIS
- +4 QUIT
- +5 ;
- QUE ;EP for queuing
- +1 FOR ABM="DUZ(2)","DUZ(0)","ABM(","ABMY(","ABMP(","%ZIS("
- SET ZTSAVE(ABM)=""
- +2 DO ^%ZTLOAD
- IF $DATA(ZTSK)
- WRITE !,"REQUEST QUEUED! Task Number: ",ZTSK,!
- +3 DO ^%ZISC
- +4 KILL ZTSK,ZTDESC,ZTSAVE,ZTRTN,IO("Q")
- +5 QUIT
- +6 ;
- LOOP ;EP for Looping thru Bill File
- +1 SET ABMP("X")=$SELECT($GET(ABMY("DT"))="V":"AD",$GET(ABMY("DT"))="A":"AP",$GET(ABMY("DT"))="X":"AX",$GET(ABMY("DT"))="P":"AE",$DATA(ABMY("INS")):"AJ",$DATA(ABMY("PAT")):"D",1:1)
- +2 IF ABMP("X")
- Begin DoDot:1
- +3 SET ABM=0
- FOR
- SET ABM=$ORDER(^ABMDBILL(DUZ(2),ABM))
- IF 'ABM
- QUIT
- DO @("DATA^"_ABMP("RTN"))
- End DoDot:1
- QUIT
- +4 IF $GET(ABMY("DT"))]""
- IF "APV"[ABMY("DT")
- SET ABMP("DT")=ABMY("DT",1)-.5
- Begin DoDot:1
- +5 FOR
- SET ABMP("DT")=$ORDER(^ABMDBILL(DUZ(2),ABMP("X"),ABMP("DT")))
- IF 'ABMP("DT")!(ABMP("DT")>(ABMY("DT",2)+.5))
- QUIT
- Begin DoDot:2
- +6 SET ABM=""
- FOR
- SET ABM=$ORDER(^ABMDBILL(DUZ(2),ABMP("X"),ABMP("DT"),ABM))
- IF 'ABM
- QUIT
- DO @("DATA^"_ABMP("RTN"))
- End DoDot:2
- End DoDot:1
- QUIT
- +7 IF $GET(ABMY("DT"))="X"
- SET ABMP("DT")=ABMY("DT",1)-.5
- Begin DoDot:1
- +8 FOR
- SET ABMP("DT")=$ORDER(^ABMDTXST(DUZ(2),"B",ABMP("DT")))
- IF 'ABMP("DT")!(ABMP("DT")>(ABMY("DT",2)+.5))
- QUIT
- Begin DoDot:2
- +9 SET ABMP("DTD")=0
- FOR
- SET ABMP("DTD")=$ORDER(^ABMDTXST(DUZ(2),"B",ABMP("DT"),ABMP("DTD")))
- IF 'ABMP("DTD")
- QUIT
- Begin DoDot:3
- +10 SET ABM=0
- FOR
- SET ABM=$ORDER(^ABMDBILL(DUZ(2),"AX",ABMP("DTD"),ABM))
- IF 'ABM
- QUIT
- DO @("DATA^"_ABMP("RTN"))
- End DoDot:3
- End DoDot:2
- End DoDot:1
- QUIT
- +11 SET ABMP("DT")=ABMY("DT",1)-1
- Begin DoDot:1
- +12 SET ABM=""
- SET ABMP("RI")=$SELECT(ABMP("X")="AJ":ABMY("INS"),1:ABMY("PAT"))
- FOR
- SET ABM=$ORDER(^ABMDBILL(DUZ(2),ABMP("X"),ABMP("RI"),ABM))
- IF 'ABM
- QUIT
- DO @("DATA^"_ABMP("RTN"))
- End DoDot:1
- +13 QUIT
