ABMDBRUN.m

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