ABMDACK.m

ABMDACK ; IHS/ASDST/DMJ - APC Visit Edits ;

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

 ;Original;TMD;02/27/96 11:42 AM

 ;

 S U="^" K ABM,ABMP,ABML

V ;

 S ABMP("ENDT")="" F  S ABMP("ENDT")=$O(^AAPCRCDS("ABILL",ABMP("ENDT"))) Q:ABMP("ENDT")=""  D

 .S ABMP("VDFN")="" F  S ABMP("VDFN")=$O(^AAPCRCDS("ABILL",ABMP("ENDT"),ABMP("VDFN"))) Q:ABMP("VDFN")=""  D V2 K ^AAPCRCDS("ABILL",ABMP("ENDT"),ABMP("VDFN"))

 G XIT

 ;

V2 Q:'$D(^AAPCRCDS(ABMP("VDFN"),0))  S ABMP("V0")=^(0),ABMP("VDT")=$P($P(ABMP("V0"),U,3),".") Q:$D(^AAPCRCDS("ACAN",ABMP("VDFN")))

 I $D(^ABMDBILL(DUZ(2),"APC",ABMP("VDFN"))) Q

 I +$P($G(^ABMDPARM(DUZ(2),1,0)),U,16) S X1=DT,X2=0-($P(^(0),U,16)*30.417) D C^%DTC Q:ABMP("VDT")<X

 S ABMP("PDFN")=$P(ABMP("V0"),U),ABMP("CLN")=$P(ABMP("V0"),U,13),ABMP("LDFN")=$P(ABMP("V0"),U,2)

 I ABMP("PDFN")=""!(ABMP("LDFN")="") Q

 I $D(^ABPVFAC("PC",ABMP("PDFN"),ABMP("VDT"))) Q

 I ABMP("CLN")]"" Q:$D(^ABMDPARM(DUZ(2),1,15,ABMP("CLN")))

 I ABMP("CLN")="" S ABMP("CLN")=1

 I '$D(^DPT(ABMP("PDFN"),0))!'$D(^AUTTLOC(ABMP("LDFN"),0))!'$D(^DIC(40.7,ABMP("CLN"),0)) Q

 S ABM=0,ABM("QIT")=0

 F  S ABM=$O(^ABMDCLM(DUZ(2),"B",ABMP("PDFN"),ABM)) Q:'ABM  D

 .Q:$D(^ABMDCLM(DUZ(2),ABM,15,0))

 .Q:$P($G(^ABMDCLM(DUZ(2),ABM,0)),U,2)='ABMP("VDT")

 .Q:$P(^ABMDCLM(DUZ(2),ABM,0),U,3)='ABMP("LDFN")

 .Q:$P(^ABMDCLM(DUZ(2),ABM,0),U,6)='ABMP("CLN")

 .S ABM("QIT")=1

 Q:ABM("QIT")

 S ABMDFN=ABMP("PDFN"),ABMVDT=ABMP("VDT")

 D ELG^ABMDLCK("",.ABML,ABMDFN,ABMVDT) Q:'$D(ABML)

 S ABM("PRI")="" F  S ABM("PRI")=$O(ABML(ABM("PRI"))) Q:'ABM("PRI")  D INS

 Q

 ;

INS S ABMP("INS")="" F  S ABMP("INS")=$O(ABML(ABM("PRI"),ABMP("INS"))) Q:'ABMP("INS")  S ABM("INS")=ABMP("INS") D ^ABMDAST L

 Q

 ;

XIT K ABM,ABMP,ABML,ABMI,ABMR

 Q

ABMDACK   ; IHS/ASDST/DMJ - APC Visit Edits ;

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

 +2       ;Original;TMD;02/27/96 11:42 AM

 +3       ;

 +4        SET U="^"

           KILL ABM,ABMP,ABML

V         ;

 +1        SET ABMP("ENDT")=""

           FOR 

               SET ABMP("ENDT")=$ORDER(^AAPCRCDS("ABILL",ABMP("ENDT")))

               IF ABMP("ENDT")=""

                   QUIT 

               Begin DoDot:1

 +2                SET ABMP("VDFN")=""

                   FOR 

                       SET ABMP("VDFN")=$ORDER(^AAPCRCDS("ABILL",ABMP("ENDT"),ABMP("VDFN")))

                       IF ABMP("VDFN")=""

                           QUIT 

                       DO V2

                       KILL ^AAPCRCDS("ABILL",ABMP("ENDT"),ABMP("VDFN"))

               End DoDot:1

 +3        GOTO XIT

 +4       ;

V2         IF '$DATA(^AAPCRCDS(ABMP("VDFN"),0))

               QUIT 

           SET ABMP("V0")=^(0)

           SET ABMP("VDT")=$PIECE($PIECE(ABMP("V0"),U,3),".")

           IF $DATA(^AAPCRCDS("ACAN",ABMP("VDFN")))

               QUIT 

 +1        IF $DATA(^ABMDBILL(DUZ(2),"APC",ABMP("VDFN")))

               QUIT 

 +2        IF +$PIECE($GET(^ABMDPARM(DUZ(2),1,0)),U,16)

               SET X1=DT

               SET X2=0-($PIECE(^(0),U,16)*30.417)

               DO C^%DTC

               IF ABMP("VDT")<X

                   QUIT 

 +3        SET ABMP("PDFN")=$PIECE(ABMP("V0"),U)

           SET ABMP("CLN")=$PIECE(ABMP("V0"),U,13)

           SET ABMP("LDFN")=$PIECE(ABMP("V0"),U,2)

 +4        IF ABMP("PDFN")=""!(ABMP("LDFN")="")

               QUIT 

 +5        IF $DATA(^ABPVFAC("PC",ABMP("PDFN"),ABMP("VDT")))

               QUIT 

 +6        IF ABMP("CLN")]""

               IF $DATA(^ABMDPARM(DUZ(2),1,15,ABMP("CLN")))

                   QUIT 

 +7        IF ABMP("CLN")=""

               SET ABMP("CLN")=1

 +8        IF '$DATA(^DPT(ABMP("PDFN"),0))!'$DATA(^AUTTLOC(ABMP("LDFN"),0))!'$DATA(^DIC(40.7,ABMP("CLN"),0))

               QUIT 

 +9        SET ABM=0

           SET ABM("QIT")=0

 +10       FOR 

               SET ABM=$ORDER(^ABMDCLM(DUZ(2),"B",ABMP("PDFN"),ABM))

               IF 'ABM

                   QUIT 

               Begin DoDot:1

 +11               IF $DATA(^ABMDCLM(DUZ(2),ABM,15,0))

                       QUIT 

 +12               IF $PIECE($GET(^ABMDCLM(DUZ(2),ABM,0)),U,2)='ABMP("VDT")

                       QUIT 

 +13               IF $PIECE(^ABMDCLM(DUZ(2),ABM,0),U,3)='ABMP("LDFN")

                       QUIT 

 +14               IF $PIECE(^ABMDCLM(DUZ(2),ABM,0),U,6)='ABMP("CLN")

                       QUIT 

 +15               SET ABM("QIT")=1

               End DoDot:1

 +16       IF ABM("QIT")

               QUIT 

 +17       SET ABMDFN=ABMP("PDFN")

           SET ABMVDT=ABMP("VDT")

 +18       DO ELG^ABMDLCK("",.ABML,ABMDFN,ABMVDT)

           IF '$DATA(ABML)

               QUIT 

 +19       SET ABM("PRI")=""

           FOR 

               SET ABM("PRI")=$ORDER(ABML(ABM("PRI")))

               IF 'ABM("PRI")

                   QUIT 

               DO INS

 +20       QUIT 

 +21      ;

INS        SET ABMP("INS")=""

           FOR 

               SET ABMP("INS")=$ORDER(ABML(ABM("PRI"),ABMP("INS")))

               IF 'ABMP("INS")

                   QUIT 

               SET ABM("INS")=ABMP("INS")

               DO ^ABMDAST

               LOCK 

 +1        QUIT 

 +2       ;

XIT        KILL ABM,ABMP,ABML,ABMI,ABMR

 +1        QUIT