ABMEAUTO.m

ABMEAUTO ; IHS/ASDST/DMJ - AUTO APPROVE CLAIM ;

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

 ;Original;DMJ;04/30/96 4:06 PM

START ;START HERE

 Q:'$G(ABMP("CDFN"))

 Q:$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),65))

 S ABMPINS=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),"^",8)

 Q:'$P($G(^ABMNINS(DUZ(2),+ABMPINS,1,+ABMP("VTYP"),0)),"^",13)

 D ^ABMDEVAR

 S ABMQUIET=1

 D ERRIN^ABMDECK

 Q:$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),"^",5)

 D ^ABMDESM

 S ABMAUTOF=1

 D ^ABMDEBIL

 I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),65)) D

 .S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".04///U" D ^DIE

 .K DR

 .N I

 .S I=0

 .F  S I=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I)) Q:'I  D

 ..Q:$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0),U,3)'="I"

 ..S DA(1)=DA

 ..S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"

 ..S DA=I

 ..S DR=".03////B"

 ..D ^DIE

 ..K DR

 .K ^ABMDTMP(ABMP("CDFN"))

 K ABMQUIET

 Q

 ; *********************************************************************

AUTOUFMS ;EP - create/populate UFMS Cashiering Session

 ;location

 S ABMLOC=$$FINDLOC^ABMUCUTL

 D ^XBFMK

 S DIC="^ABMUCASH("

 S DIC(0)="LMN"

 S (X,DINUM)="`"_ABMLOC

 D ^DIC

 I Y<0 Q

 S ABMLOC=+Y

 ;

 ;user

 D ^XBFMK

 S DA(1)=ABMLOC

 S DIC="^ABMUCASH(DA(1),10,"

 S DIC(0)="LMN"

 S DIC("P")=$P(^DD(9002274.45,".02",0),U,2)

 S (X,DINUM)="`"_$S(+$G(DUZ)'=0:DUZ,1:$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,4))

 D ^DIC

 I Y<0 Q

 S ABMUSER=+Y

 ;

 ;sign in date

 ;check for existing open session

 I $D(^ABMUCASH(ABMLOC,10,ABMUSER,20,0)) D

 .S ABMSDT=999999999

 .S ABMSFLG=0

 .F  S ABMSDT=$O(^ABMUCASH(ABMLOC,10,ABMUSER,20,ABMSDT),-1) Q:+ABMSDT=0  D  Q:ABMSFLG=1

 ..Q:($P($G(^ABMUCASH(ABMLOC,10,ABMUSER,20,ABMSDT,0)),U,4)'="O")

 ..S ABMSFLG=1

 I +$G(ABMSDT)=0 D

 .D ^XBFMK

 .S DA(2)=ABMLOC

 .S DA(1)=ABMUSER

 .S DIC="^ABMUCASH("_DA(2)_",10,"_DA(1)_",20,"

 .D NOW^%DTC

 .S X=%

 .S DIC(0)="LMO"

 .S DIC("P")=$P(^DD(9002274.4502,".02",0),U,2)

 .S DIC("DR")=".04////O"

 .D ^DIC

 .Q:Y<0

 .S ABMSDT=+Y

 ;

 ;insurer type

 D ^XBFMK

 S DA(3)=ABMLOC

 S DA(2)=ABMUSER

 S DA(1)=ABMSDT

 S DIC="^ABMUCASH("_DA(3)_",10,"_DA(2)_",20,"_DA(1)_",11,"

 S DIC(0)="LM"

 S DIC("P")=$P(^DD(9002274.45102,11,0),U,2)

 S X=$P($G(^AUTNINS($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,8),2)),U)

 S ABMP("INS")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,8)

 D ^DIC

 I +Y<0 Q

 S ABMBA=+Y

 ;

 ;bill entry

 D ^XBFMK

 S DA(4)=ABMLOC

 S DA(3)=ABMUSER

 S DA(2)=ABMSDT

 S DA(1)=ABMBA

 S DIC="^ABMUCASH("_DA(4)_",10,"_DA(3)_",20,"_DA(2)_",11,"_DA(1)_",2,"

 S X=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U)

 S DIC(0)="LMO"

 S DIC("P")=$P(^DD(9002274.4510211,2,0),U,2)

 S DIC("DR")=".02////"_DUZ(2)_";.03////"_ABMP("BDFN")

 K DD,DO

 D FILE^DICN

 K ABMAUTOF

 Q

ABMEAUTO  ; IHS/ASDST/DMJ - AUTO APPROVE CLAIM ;

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

 +2       ;Original;DMJ;04/30/96 4:06 PM

START     ;START HERE

 +1        IF '$GET(ABMP("CDFN"))

               QUIT 

 +2        IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),65))

               QUIT 

 +3        SET ABMPINS=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),"^",8)

 +4        IF '$PIECE($GET(^ABMNINS(DUZ(2),+ABMPINS,1,+ABMP("VTYP"),0)),"^",13)

               QUIT 

 +5        DO ^ABMDEVAR

 +6        SET ABMQUIET=1

 +7        DO ERRIN^ABMDECK

 +8        IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),"^",5)

               QUIT 

 +9        DO ^ABMDESM

 +10       SET ABMAUTOF=1

 +11       DO ^ABMDEBIL

 +12       IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),65))

               Begin DoDot:1

 +13               SET DIE="^ABMDCLM(DUZ(2),"

                   SET DA=ABMP("CDFN")

                   SET DR=".04///U"

                   DO ^DIE

 +14               KILL DR

 +15               NEW I

 +16               SET I=0

 +17               FOR 

                       SET I=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I))

                       IF 'I

                           QUIT 

                       Begin DoDot:2

 +18                       IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0),U,3)'="I"

                               QUIT 

 +19                       SET DA(1)=DA

 +20                       SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"

 +21                       SET DA=I

 +22                       SET DR=".03////B"

 +23                       DO ^DIE

 +24                       KILL DR

                       End DoDot:2

 +25               KILL ^ABMDTMP(ABMP("CDFN"))

               End DoDot:1

 +26       KILL ABMQUIET

 +27       QUIT 

 +28      ; *********************************************************************

AUTOUFMS  ;EP - create/populate UFMS Cashiering Session

 +1       ;location

 +2        SET ABMLOC=$$FINDLOC^ABMUCUTL

 +3        DO ^XBFMK

 +4        SET DIC="^ABMUCASH("

 +5        SET DIC(0)="LMN"

 +6        SET (X,DINUM)="`"_ABMLOC

 +7        DO ^DIC

 +8        IF Y<0

               QUIT 

 +9        SET ABMLOC=+Y

 +10      ;

 +11      ;user

 +12       DO ^XBFMK

 +13       SET DA(1)=ABMLOC

 +14       SET DIC="^ABMUCASH(DA(1),10,"

 +15       SET DIC(0)="LMN"

 +16       SET DIC("P")=$PIECE(^DD(9002274.45,".02",0),U,2)

 +17       SET (X,DINUM)="`"_$SELECT(+$GET(DUZ)'=0:DUZ,1:$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,4))

 +18       DO ^DIC

 +19       IF Y<0

               QUIT 

 +20       SET ABMUSER=+Y

 +21      ;

 +22      ;sign in date

 +23      ;check for existing open session

 +24       IF $DATA(^ABMUCASH(ABMLOC,10,ABMUSER,20,0))

               Begin DoDot:1

 +25               SET ABMSDT=999999999

 +26               SET ABMSFLG=0

 +27               FOR 

                       SET ABMSDT=$ORDER(^ABMUCASH(ABMLOC,10,ABMUSER,20,ABMSDT),-1)

                       IF +ABMSDT=0

                           QUIT 

                       Begin DoDot:2

 +28                       IF ($PIECE($GET(^ABMUCASH(ABMLOC,10,ABMUSER,20,ABMSDT,0)),U,4)'="O")

                               QUIT 

 +29                       SET ABMSFLG=1

                       End DoDot:2

                       IF ABMSFLG=1

                           QUIT 

               End DoDot:1

 +30       IF +$GET(ABMSDT)=0

               Begin DoDot:1

 +31               DO ^XBFMK

 +32               SET DA(2)=ABMLOC

 +33               SET DA(1)=ABMUSER

 +34               SET DIC="^ABMUCASH("_DA(2)_",10,"_DA(1)_",20,"

 +35               DO NOW^%DTC

 +36               SET X=%

 +37               SET DIC(0)="LMO"

 +38               SET DIC("P")=$PIECE(^DD(9002274.4502,".02",0),U,2)

 +39               SET DIC("DR")=".04////O"

 +40               DO ^DIC

 +41               IF Y<0

                       QUIT 

 +42               SET ABMSDT=+Y

               End DoDot:1

 +43      ;

 +44      ;insurer type

 +45       DO ^XBFMK

 +46       SET DA(3)=ABMLOC

 +47       SET DA(2)=ABMUSER

 +48       SET DA(1)=ABMSDT

 +49       SET DIC="^ABMUCASH("_DA(3)_",10,"_DA(2)_",20,"_DA(1)_",11,"

 +50       SET DIC(0)="LM"

 +51       SET DIC("P")=$PIECE(^DD(9002274.45102,11,0),U,2)

 +52       SET X=$PIECE($GET(^AUTNINS($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,8),2)),U)

 +53       SET ABMP("INS")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,8)

 +54       DO ^DIC

 +55       IF +Y<0

               QUIT 

 +56       SET ABMBA=+Y

 +57      ;

 +58      ;bill entry

 +59       DO ^XBFMK

 +60       SET DA(4)=ABMLOC

 +61       SET DA(3)=ABMUSER

 +62       SET DA(2)=ABMSDT

 +63       SET DA(1)=ABMBA

 +64       SET DIC="^ABMUCASH("_DA(4)_",10,"_DA(3)_",20,"_DA(2)_",11,"_DA(1)_",2,"

 +65       SET X=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U)

 +66       SET DIC(0)="LMO"

 +67       SET DIC("P")=$PIECE(^DD(9002274.4510211,2,0),U,2)

 +68       SET DIC("DR")=".02////"_DUZ(2)_";.03////"_ABMP("BDFN")

 +69       KILL DD,DO

 +70       DO FILE^DICN

 +71       KILL ABMAUTOF

 +72       QUIT