- ABMDBRUN ; IHS/ASDST/DMJ - Reprint Unpaid Bills ;
- ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- ;
- K ABM,ABMY S ABMP("CNT")=0
- SEL W ! K DIC S DIC(0)="QEAM",DIC="^ABMDEXP(",DIC("A")="Select FORM to Re-Print: ",DIC("S")="I '$P($G(^(1)),U,3)"
- D ^DIC G XIT:$D(DUOUT)!$D(DTOUT)!(X=""),SEL:Y<1
- S ABMP("FORM")=Y
- S ABMP("TYP")=0,ABM("NODX")="",ABM("OVER-DUE")=""
- D ^ABMDRSEL G XIT:$D(DTOUT)!$D(DUOUT)
- ;
- 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") S ABM=0 F S ABM=$O(^ABMDBILL(DUZ(2),ABM)) G XIT:'ABM D DATA
- G OTH:$G(ABMY("DT"))="" S ABMP("DT")=ABMY("DT",1)-1
- I "APV"[$G(ABMY("DT")) S ABMP("DT")=ABMY("DT",1)-1 F S ABMP("DT")=$O(^ABMDBILL(DUZ(2),ABMP("X"),ABMP("DT"))) G XIT:'+ABMP("DT")!(ABMP("DT")>ABMY("DT",2)) D
- .S ABM="" F S ABM=$O(^ABMDBILL(DUZ(2),ABMP("X"),ABMP("DT"),ABM)) Q:'ABM D DATA
- I $G(ABMY("DT"))="X" S ABMP("DT")=ABMY("DT",1)-1 F S ABMP("DT")=$O(^ABMDTXST(DUZ(2),"B",ABMP("DT"))) G XIT:'ABMP("DT")!(ABMP("DT")>ABMY("DT",2)) D
- .S ABMP("DTD")=0 F S ABMP("DTD")=$O(^ABMDTXST(DUZ(2),"B",ABMP("DT"),ABMP("DTD"))) Q:'ABMP("DTD") D
- ..I $P(^ABMDTXST(DUZ(2),ABMP("DTD"),0),U,2)'=+ABMP("FORM") Q
- ..S ABM=0 F S ABM=$O(^ABMDBILL(DUZ(2),"AX",ABMP("DTD"),ABM)) Q:'ABM D DATA
- OTH 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
- G XIT
- ;
- DATA ;CHECK FOR HIT
- Q:"BT"'[$P(^ABMDBILL(DUZ(2),ABM,0),"^",4)
- S ABMP("HIT")=0 D ^ABMDRCHK Q:'ABMP("HIT")
- S ABMP("CNT")=ABMP("CNT")+1
- S:'$D(ABMY("FORM")) ABMY("FORM")=ABMP("FORM")
- S ABMY(ABM)=""
- Q
- ;
- XIT K ABM
- Q
- ABMDBRUN ; IHS/ASDST/DMJ - Reprint Unpaid Bills ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- +2 ;
- +3 KILL ABM,ABMY
- SET ABMP("CNT")=0
- SEL WRITE !
- KILL DIC
- SET DIC(0)="QEAM"
- SET DIC="^ABMDEXP("
- SET DIC("A")="Select FORM to Re-Print: "
- SET DIC("S")="I '$P($G(^(1)),U,3)"
- +1 DO ^DIC
- IF $DATA">DATA(DUOUT)!$DATA">DATA(DTOUT)!(X="")
- GOTO XIT
- IF Y<1
- GOTO SEL
- +2 SET ABMP("FORM")=Y
- +3 SET ABMP("TYP")=0
- SET ABM("NODX")=""
- SET ABM("OVER-DUE")=""
- +4 DO ^ABMDRSEL
- IF $DATA">DATA(DTOUT)!$DATA">DATA(DUOUT)
- GOTO XIT
- +5 ;
- +6 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">DATA(ABMY("INS")):"AJ",$DATA">DATA(ABMY("PAT")):"D",1:1)
- +7 IF ABMP("X")
- SET ABM=0
- FOR
- SET ABM=$ORDER(^ABMDBILL(DUZ(2),ABM))
- IF 'ABM
- GOTO XIT
- DO DATA
- +8 IF $GET(ABMY("DT"))=""
- GOTO OTH
- SET ABMP("DT")=ABMY("DT",1)-1
- +9 IF "APV"[$GET(ABMY("DT"))
- SET ABMP("DT")=ABMY("DT",1)-1
- FOR
- SET ABMP("DT")=$ORDER(^ABMDBILL(DUZ(2),ABMP("X"),ABMP("DT")))
- IF '+ABMP("DT")!(ABMP("DT")>ABMY("DT",2))
- GOTO XIT
- Begin DoDot:1
- +10 SET ABM=""
- FOR
- SET ABM=$ORDER(^ABMDBILL(DUZ(2),ABMP("X"),ABMP("DT"),ABM))
- IF 'ABM
- QUIT
- DO DATA
- End DoDot:1
- +11 IF $GET(ABMY("DT"))="X"
- SET ABMP("DT")=ABMY("DT",1)-1
- FOR
- SET ABMP("DT")=$ORDER(^ABMDTXST(DUZ(2),"B",ABMP("DT")))
- IF 'ABMP("DT")!(ABMP("DT")>ABMY("DT",2))
- GOTO XIT
- Begin DoDot:1
- +12 SET ABMP("DTD")=0
- FOR
- SET ABMP("DTD")=$ORDER(^ABMDTXST(DUZ(2),"B",ABMP("DT"),ABMP("DTD")))
- IF 'ABMP("DTD")
- QUIT
- Begin DoDot:2
- +13 IF $PIECE(^ABMDTXST(DUZ(2),ABMP("DTD"),0),U,2)'=+ABMP("FORM")
- QUIT
- +14 SET ABM=0
- FOR
- SET ABM=$ORDER(^ABMDBILL(DUZ(2),"AX",ABMP("DTD"),ABM))
- IF 'ABM
- QUIT
- DO DATA
- End DoDot:2
- End DoDot:1
- OTH 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
- +1 GOTO XIT
- +2 ;
- DATA ;CHECK FOR HIT
- +1 IF "BT"'[$PIECE(^ABMDBILL(DUZ(2),ABM,0),"^",4)
- QUIT
- +2 SET ABMP("HIT")=0
- DO ^ABMDRCHK
- IF 'ABMP("HIT")
- QUIT
- +3 SET ABMP("CNT")=ABMP("CNT")+1
- +4 IF '$DATA(ABMY("FORM"))
- SET ABMY("FORM")=ABMP("FORM")
- +5 SET ABMY(ABM)=""
- +6 QUIT
- +7 ;
- XIT KILL ABM
- +1 QUIT