ABMEFOVR ; IHS/SD/SDR - Setup 837 Form Override ;
;;2.6;IHS 3P BILLING SYSTEM;**6,8,9,10,21**;NOV 12, 2009;Build 379
;IHS/SD/SDR - 2.6*21 - HEAT70826 - Made changes to allow for removal of loop 2310B.
;
START ;start
K DIC,ABMNM
W !
D INS Q:'$G(ABMINS)
D FORM Q:'$G(ABMFORM)
STARTA D VTYP Q:'$G(ABMVTYP)
D LOOP Q:($G(ABMLOOP)="")
D SEND Q:$G(ABMSEND)=""
I ABMLOOP="2310B" D 2310B Q ;abm*2.6*21 IHS/SD/SDR HEAT70826
D SEGMENT Q:($G(ABMSEG)="")
I ABMSEND="N",(ABMSEG="REF") D NOSEND Q
D ELEMENT Q:($G(ABMELE)="")
;
S ABMNM="FM"_ABMFORM_" "_ABMLOOP_" "_ABMELE_" "_ABMVTYP
S:ABMVTYP=9999 ABMVTYP=""
D FILE
K ABMINS,ABMFORM,ABMLOOP,ABMSEG,ABMELE,ABMANS,ABMDA,ABMEXIST,ABMVTYP,ABMSEND,ABMNM
Q
INS ;select insurer
;S DIC="^ABMNINS(DUZ(2)," ;abm*2.6*9 NOHEAT
S DIC="^AUTNINS(" ;abm*2.6*9 NOHEAT
S DIC(0)="AEMQ"
D ^DIC Q:+Y<0
S ABMINS=+Y
Q
FORM ;select form
S DIC="^ABMDEXP(",DIC(0)="AEMQ"
S DIC("S")="I +Y=31!(+Y=32)!(+Y=33)"
D ^DIC K DIC
Q:+Y<0
S ABMFORM=+Y
Q
VTYP ;select visit type
S DIC="^ABMDVTYP("
S DIC(0)="AEMQ"
S DIC("A")="Enter visit type, or leave blank for all. "
D ^DIC
I X="" D
.S Y=9999
.W "ALL"
Q:+Y<0
S ABMVTYP=+Y
Q
LOOP ;select loop
S DIR(0)="S^"_$P($T(LOOPS),";;",2)
S DIR("A")="Select Loop"
D ^DIR K DIR
Q:'+Y
S ABMLOOP=Y(0)
Q
SEND ;select send/don't send
S DIR(0)="S^S:Send;N:Don't Send"
S DIR("A")="Select"
D ^DIR K DIR
S ABMSEND=Y
Q
;start new abm*2.6*21 IHS/SD/SDR HEAT70826
2310B ;EP
I ABMSEND="N" D ASKLOOP Q
Q:'$D(^ABMNINS(DUZ(2),ABMINS,2.5,"ASEND",ABMFORM,"2310B","N"))
;if it gets here that means that they had said Don't send but are changing it to send
;existing entry should just be removed
S DA(1)=ABMINS
S DA=$O(^ABMNINS(DUZ(2),ABMINS,2.5,"ASEND",ABMFORM,"2310B","00",0,"N",0))
S DIK="^ABMNINS(DUZ(2),"_DA(1)_",2.5,"
D ^DIK
Q
ASKLOOP ;
S DIR(0)="Y"
S DIR("A")="Remove WHOLE loop"
S DIR("B")="N"
D ^DIR K DIR
S ABMSKIPL=Y
I ABMSKIPL="N" Q
S ABMQFLG=1
I '$D(^ABMNINS(DUZ(2),ABMINS)) D Q:+Y<0
.D ^XBFMK
.S X="`"_ABMINS
.S DIC="^ABMNINS(DUZ(2),"
.S DIC(0)="LX"
.D ^DIC
D ^XBFMK
S ABMNM="FM"_ABMFORM_" "_ABMLOOP_" DON'T SEND"
S:ABMVTYP=9999 ABMVTYP=""
S DA(1)=ABMINS
S DIC="^ABMNINS(DUZ(2),"_DA(1)_",2.5,"
S DIC("P")=$P(^DD(9002274.09,2.5,0),U,2)
S X=ABMNM
S DIC(0)="LXE" D ^DIC
Q:+Y<0
S DA=+Y
S ABMDA=DA
S DIE=DIC
S ABMANS=1
I $P(Y,U,3)'=1 D
.S DIR(0)="S^1:ADD/EDIT;2:DELETE"
.S DIR("A")="Add/Edit or Delete Entry?"
.S DIR("B")="ADD/EDIT"
.D ^DIR K DIR
.Q:'Y S ABMANS=Y
I ABMANS=1 D
.S DR=".02///"_ABMFORM_";.03///"_ABMLOOP_";.04////00;.05////0;.06///"_ABMVTYP_";.08///"_ABMSEND
S:ABMANS=2 DR=".01///@"
D ^DIE
I ABMANS=2 D
.W !,"Entry Deleted.",!
.D EOP^ABMDUTL(1)
Q
;end new abm*2.6*21 IHS/SD/SDR HEAT70826
SEGMENT ;select segment
S DIR(0)="S^"_$P($T(@ABMLOOP),";;",2)
S DIR("A")="Select Segment"
D ^DIR K DIR
Q:'+Y
S ABMSEG=Y(0)
Q
ELEMENT ;select element
D ^XBFMK
S DIR(0)="SO^"_$P($T(@ABMSEG),";;",2)
S DIR("A")="Select Element"
D ^DIR K DIR
Q:'+Y
S ABMELE=Y(0)
I ABMSEND="S"&(+$O(^ABMNINS(DUZ(2),ABMINS,2.5,"ASEND",ABMFORM,ABMLOOP,ABMSEG,ABMELE,"N",0))'=0) D
.D ^XBFMK
.S DA(1)=ABMINS
.S DA=$O(^ABMNINS(DUZ(2),ABMINS,2.5,"ASEND",ABMFORM,ABMLOOP,ABMSEG,ABMELE,"N",0))
.S DIK="^ABMNINS(DUZ(2),"_DA(1)_",2.5,"
.D ^DIK
Q
FILE ;
S ABMEXIST=$G(^ABMNINS(DUZ(2),ABMINS,2.5,"A837",ABMFORM,ABMLOOP,ABMSEG,ABMELE,+ABMVTYP)) D
.Q:ABMEXIST=""
.W !!,"Current Value: ",ABMEXIST
.W !,"Visit Type: ",$S(ABMVTYP="":"ALL",1:ABMVTYP)
D ^XBFMK
S DA(1)=ABMINS
S DIC="^ABMNINS(DUZ(2),"_DA(1)_",2.5,"
S DIC("P")=$P(^DD(9002274.09,2.5,0),U,2)
S X=ABMNM
S DIC(0)="LXE" D ^DIC
Q:+Y<0
S DA=+Y
S ABMDA=DA
S DIE=DIC
S ABMANS=1
I $P(Y,U,3)'=1 D
.S DIR(0)="S^1:ADD/EDIT;2:DELETE"
.S DIR("A")="Add/Edit or Delete Entry?"
.S DIR("B")="ADD/EDIT"
.D ^DIR K DIR
.Q:'Y S ABMANS=Y
I ABMANS=1 D
.S DR=".02///"_ABMFORM_";.03///"_ABMLOOP_";.04///"_ABMSEG_";.05///"_ABMELE_";.06///"_ABMVTYP_";.08///"_ABMSEND
.I ABMSEND="S" S DR=DR_";.07//"
S:ABMANS=2 DR=".01///@"
D ^DIE
I ABMANS=2 D
.W !,"Entry Deleted.",!
.D EOP^ABMDUTL(1)
I ABMNM["ISA"!(ABMNM["GS")!(ABMNM["NM")!(ABMNM["REF") D
.K DIR
.S DIR(0)="Y"
.S DIR("A")="EDIT ANOTHER SEGMENT?"
.S DIR("B")="N"
.D ^DIR
.K DIR
.I Y=1 K ABMLOOP,ABMSEG,ABMELE,ABMVTYP G STARTA
Q
NOSEND ;
S ABMNM="FM"_ABMFORM_" "_ABMLOOP_" "_ABMSEG_" DON'T SEND"
S:ABMVTYP=9999 ABMVTYP=""
S ABMELE=""
D ^XBFMK
S DA(1)=ABMINS
S DIC="^ABMNINS(DUZ(2),"_DA(1)_",2.5,"
S DIC("P")=$P(^DD(9002274.09,2.5,0),U,2)
S X=ABMNM
S DIC(0)="LXE" D ^DIC
Q:+Y<0
S DA=+Y
S ABMDA=DA
S DIE=DIC
S DR=".02///"_ABMFORM_";.03///"_ABMLOOP_";.04///"_ABMSEG_";.05///"_ABMELE_";.06///"_ABMVTYP_";.08///"_ABMSEND
D ^DIE
Q
;
LOOPS ;;1:HEADER;2:1000A;3:1000B;4:2010AA;5:2010BB;6:2000B;7:2310B
;abm*2.6*21 IHS/SD/SDR HEAT70826 added loop 2310B
;
1000A ;;1:NM1
1000B ;;1:NM1
2010AA ;;1:NM1;2:REF
2010BB ;;1:NM1
2000B ;;1:SBR
;
ISA ;;1:ISA02;2:ISA03;3:ISA04;4:ISA05;5:ISA06;6:ISA07;7:ISA08;8:ISA14;9:ISA15
;;1:ISA02;2:ISA03;3:ISA04;4:ISA05;5:ISA06;6:ISA07;7:ISA08;8:ISA15 ;old line abm*2.6*10 HEAT74624
;;1:ISA03;2:ISA04;3:ISA05;4:ISA06;5:ISA07;6:ISA08;7:ISA15 ;old line ABM*2.6*8
GS ;;1:GS02;2:GS03
NM1 ;;1:NM103;2:NM108;3:NM109
REF ;;1:REF01;2:REF02
SBR ;;1:SBR09
ABMEFOVR ; IHS/SD/SDR - Setup 837 Form Override ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**6,8,9,10,21**;NOV 12, 2009;Build 379
+2 ;IHS/SD/SDR - 2.6*21 - HEAT70826 - Made changes to allow for removal of loop 2310B.
+3 ;
START ;start
+1 KILL DIC,ABMNM
+2 WRITE !
+3 DO INS
IF '$GET(ABMINS)
QUIT
+4 DO FORM
IF '$GET(ABMFORM)
QUIT
STARTA DO VTYP
IF '$GET(ABMVTYP)
QUIT
+1 DO LOOP
IF ($GET(ABMLOOP)="")
QUIT
+2 DO SEND
IF $GET(ABMSEND)=""
QUIT
+3 ;abm*2.6*21 IHS/SD/SDR HEAT70826
IF ABMLOOP="2310B"
DO 2310B
QUIT
+4 DO SEGMENT
IF ($GET(ABMSEG)="")
QUIT
+5 IF ABMSEND="N"
IF (ABMSEG="REF")
DO NOSEND
QUIT
+6 DO ELEMENT
IF ($GET(ABMELE)="")
QUIT
+7 ;
+8 SET ABMNM="FM"_ABMFORM_" "_ABMLOOP_" "_ABMELE_" "_ABMVTYP
+9 IF ABMVTYP=9999
SET ABMVTYP=""
+10 DO FILE
+11 KILL ABMINS,ABMFORM,ABMLOOP,ABMSEG,ABMELE,ABMANS,ABMDA,ABMEXIST,ABMVTYP,ABMSEND,ABMNM
+12 QUIT
INS ;select insurer
+1 ;S DIC="^ABMNINS(DUZ(2)," ;abm*2.6*9 NOHEAT
+2 ;abm*2.6*9 NOHEAT
SET DIC="^AUTNINS("
+3 SET DIC(0)="AEMQ"
+4 DO ^DIC
IF +Y<0
QUIT
+5 SET ABMINS=+Y
+6 QUIT
FORM ;select form
+1 SET DIC="^ABMDEXP("
SET DIC(0)="AEMQ"
+2 SET DIC("S")="I +Y=31!(+Y=32)!(+Y=33)"
+3 DO ^DIC
KILL DIC
+4 IF +Y<0
QUIT
+5 SET ABMFORM=+Y
+6 QUIT
VTYP ;select visit type
+1 SET DIC="^ABMDVTYP("
+2 SET DIC(0)="AEMQ"
+3 SET DIC("A")="Enter visit type, or leave blank for all. "
+4 DO ^DIC
+5 IF X=""
Begin DoDot:1
+6 SET Y=9999
+7 WRITE "ALL"
End DoDot:1
+8 IF +Y<0
QUIT
+9 SET ABMVTYP=+Y
+10 QUIT
LOOP ;select loop
+1 SET DIR(0)="S^"_$PIECE($TEXT(LOOPS),";;",2)
+2 SET DIR("A")="Select Loop"
+3 DO ^DIR
KILL DIR
+4 IF '+Y
QUIT
+5 SET ABMLOOP=Y(0)
+6 QUIT
SEND ;select send/don't send
+1 SET DIR(0)="S^S:Send;N:Don't Send"
+2 SET DIR("A")="Select"
+3 DO ^DIR
KILL DIR
+4 SET ABMSEND=Y
+5 QUIT
+6 ;start new abm*2.6*21 IHS/SD/SDR HEAT70826
2310B ;EP
+1 IF ABMSEND="N"
DO ASKLOOP
QUIT
+2 IF '$DATA(^ABMNINS(DUZ(2),ABMINS,2.5,"ASEND",ABMFORM,"2310B","N"))
QUIT
+3 ;if it gets here that means that they had said Don't send but are changing it to send
+4 ;existing entry should just be removed
+5 SET DA(1)=ABMINS
+6 SET DA=$ORDER(^ABMNINS(DUZ(2),ABMINS,2.5,"ASEND",ABMFORM,"2310B","00",0,"N",0))
+7 SET DIK="^ABMNINS(DUZ(2),"_DA(1)_",2.5,"
+8 DO ^DIK
+9 QUIT
ASKLOOP ;
+1 SET DIR(0)="Y"
+2 SET DIR("A")="Remove WHOLE loop"
+3 SET DIR("B")="N"
+4 DO ^DIR
KILL DIR
+5 SET ABMSKIPL=Y
+6 IF ABMSKIPL="N"
QUIT
+7 SET ABMQFLG=1
+8 IF '$DATA(^ABMNINS(DUZ(2),ABMINS))
Begin DoDot:1
+9 DO ^XBFMK
+10 SET X="`"_ABMINS
+11 SET DIC="^ABMNINS(DUZ(2),"
+12 SET DIC(0)="LX"
+13 DO ^DIC
End DoDot:1
IF +Y<0
QUIT
+14 DO ^XBFMK
+15 SET ABMNM="FM"_ABMFORM_" "_ABMLOOP_" DON'T SEND"
+16 IF ABMVTYP=9999
SET ABMVTYP=""
+17 SET DA(1)=ABMINS
+18 SET DIC="^ABMNINS(DUZ(2),"_DA(1)_",2.5,"
+19 SET DIC("P")=$PIECE(^DD(9002274.09,2.5,0),U,2)
+20 SET X=ABMNM
+21 SET DIC(0)="LXE"
DO ^DIC
+22 IF +Y<0
QUIT
+23 SET DA=+Y
+24 SET ABMDA=DA
+25 SET DIE=DIC
+26 SET ABMANS=1
+27 IF $PIECE(Y,U,3)'=1
Begin DoDot:1
+28 SET DIR(0)="S^1:ADD/EDIT;2:DELETE"
+29 SET DIR("A")="Add/Edit or Delete Entry?"
+30 SET DIR("B")="ADD/EDIT"
+31 DO ^DIR
KILL DIR
+32 IF 'Y
QUIT
SET ABMANS=Y
End DoDot:1
+33 IF ABMANS=1
Begin DoDot:1
+34 SET DR=".02///"_ABMFORM_";.03///"_ABMLOOP_";.04////00;.05////0;.06///"_ABMVTYP_";.08///"_ABMSEND
End DoDot:1
+35 IF ABMANS=2
SET DR=".01///@"
+36 DO ^DIE
+37 IF ABMANS=2
Begin DoDot:1
+38 WRITE !,"Entry Deleted.",!
+39 DO EOP^ABMDUTL(1)
End DoDot:1
+40 QUIT
+41 ;end new abm*2.6*21 IHS/SD/SDR HEAT70826
SEGMENT ;select segment
+1 SET DIR(0)="S^"_$PIECE($TEXT(@ABMLOOP),";;",2)
+2 SET DIR("A")="Select Segment"
+3 DO ^DIR
KILL DIR
+4 IF '+Y
QUIT
+5 SET ABMSEG=Y(0)
+6 QUIT
ELEMENT ;select element
+1 DO ^XBFMK
+2 SET DIR(0)="SO^"_$PIECE($TEXT(@ABMSEG),";;",2)
+3 SET DIR("A")="Select Element"
+4 DO ^DIR
KILL DIR
+5 IF '+Y
QUIT
+6 SET ABMELE=Y(0)
+7 IF ABMSEND="S"&(+$ORDER(^ABMNINS(DUZ(2),ABMINS,2.5,"ASEND",ABMFORM,ABMLOOP,ABMSEG,ABMELE,"N",0))'=0)
Begin DoDot:1
+8 DO ^XBFMK
+9 SET DA(1)=ABMINS
+10 SET DA=$ORDER(^ABMNINS(DUZ(2),ABMINS,2.5,"ASEND",ABMFORM,ABMLOOP,ABMSEG,ABMELE,"N",0))
+11 SET DIK="^ABMNINS(DUZ(2),"_DA(1)_",2.5,"
+12 DO ^DIK
End DoDot:1
+13 QUIT
FILE ;
+1 SET ABMEXIST=$GET(^ABMNINS(DUZ(2),ABMINS,2.5,"A837",ABMFORM,ABMLOOP,ABMSEG,ABMELE,+ABMVTYP))
Begin DoDot:1
+2 IF ABMEXIST=""
QUIT
+3 WRITE !!,"Current Value: ",ABMEXIST
+4 WRITE !,"Visit Type: ",$SELECT(ABMVTYP="":"ALL",1:ABMVTYP)
End DoDot:1
+5 DO ^XBFMK
+6 SET DA(1)=ABMINS
+7 SET DIC="^ABMNINS(DUZ(2),"_DA(1)_",2.5,"
+8 SET DIC("P")=$PIECE(^DD(9002274.09,2.5,0),U,2)
+9 SET X=ABMNM
+10 SET DIC(0)="LXE"
DO ^DIC
+11 IF +Y<0
QUIT
+12 SET DA=+Y
+13 SET ABMDA=DA
+14 SET DIE=DIC
+15 SET ABMANS=1
+16 IF $PIECE(Y,U,3)'=1
Begin DoDot:1
+17 SET DIR(0)="S^1:ADD/EDIT;2:DELETE"
+18 SET DIR("A")="Add/Edit or Delete Entry?"
+19 SET DIR("B")="ADD/EDIT"
+20 DO ^DIR
KILL DIR
+21 IF 'Y
QUIT
SET ABMANS=Y
End DoDot:1
+22 IF ABMANS=1
Begin DoDot:1
+23 SET DR=".02///"_ABMFORM_";.03///"_ABMLOOP_";.04///"_ABMSEG_";.05///"_ABMELE_";.06///"_ABMVTYP_";.08///"_ABMSEND
+24 IF ABMSEND="S"
SET DR=DR_";.07//"
End DoDot:1
+25 IF ABMANS=2
SET DR=".01///@"
+26 DO ^DIE
+27 IF ABMANS=2
Begin DoDot:1
+28 WRITE !,"Entry Deleted.",!
+29 DO EOP^ABMDUTL(1)
End DoDot:1
+30 IF ABMNM["ISA"!(ABMNM["GS")!(ABMNM["NM")!(ABMNM["REF")
Begin DoDot:1
+31 KILL DIR
+32 SET DIR(0)="Y"
+33 SET DIR("A")="EDIT ANOTHER SEGMENT?"
+34 SET DIR("B")="N"
+35 DO ^DIR
+36 KILL DIR
+37 IF Y=1
KILL ABMLOOP,ABMSEG,ABMELE,ABMVTYP
GOTO STARTA
End DoDot:1
+38 QUIT
NOSEND ;
+1 SET ABMNM="FM"_ABMFORM_" "_ABMLOOP_" "_ABMSEG_" DON'T SEND"
+2 IF ABMVTYP=9999
SET ABMVTYP=""
+3 SET ABMELE=""
+4 DO ^XBFMK
+5 SET DA(1)=ABMINS
+6 SET DIC="^ABMNINS(DUZ(2),"_DA(1)_",2.5,"
+7 SET DIC("P")=$PIECE(^DD(9002274.09,2.5,0),U,2)
+8 SET X=ABMNM
+9 SET DIC(0)="LXE"
DO ^DIC
+10 IF +Y<0
QUIT
+11 SET DA=+Y
+12 SET ABMDA=DA
+13 SET DIE=DIC
+14 SET DR=".02///"_ABMFORM_";.03///"_ABMLOOP_";.04///"_ABMSEG_";.05///"_ABMELE_";.06///"_ABMVTYP_";.08///"_ABMSEND
+15 DO ^DIE
+16 QUIT
+17 ;
LOOPS ;;1:HEADER;2:1000A;3:1000B;4:2010AA;5:2010BB;6:2000B;7:2310B
+1 ;abm*2.6*21 IHS/SD/SDR HEAT70826 added loop 2310B
+2 ;
1000A ;;1:NM1
1000B ;;1:NM1
2010AA ;;1:NM1;2:REF
2010BB ;;1:NM1
2000B ;;1:SBR
+1 ;
ISA ;;1:ISA02;2:ISA03;3:ISA04;4:ISA05;5:ISA06;6:ISA07;7:ISA08;8:ISA14;9:ISA15
+1 ;;1:ISA02;2:ISA03;3:ISA04;4:ISA05;5:ISA06;6:ISA07;7:ISA08;8:ISA15 ;old line abm*2.6*10 HEAT74624
+2 ;;1:ISA03;2:ISA04;3:ISA05;4:ISA06;5:ISA07;6:ISA08;7:ISA15 ;old line ABM*2.6*8
GS ;;1:GS02;2:GS03
NM1 ;;1:NM103;2:NM108;3:NM109
REF ;;1:REF01;2:REF02
SBR ;;1:SBR09
