ABMPT259 ; IHS/ASDST/SDR - 3P BILLING 2.5 Patch 9 POST INIT ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
;
Q
PREINST ;
Q
EN ; EP
D ERRCODES ; add new error codes
D EXPMUDT ;update export mode with new questions
D XREF ;index GROUP CONTROL NUMBER in 3P TX Status file
D ECODES ;add new 3P Codes
D ZNODE ;populate 0-node for 3P Cancelled Claims Data
D TCODE ;Change TRANCODE to TRANSCODE
D QUES ;add questions to 3P Page 3 Questions file
D POSTF ;populated export mode on past POS claims
D NEWVT ;new Visit Type for task 2
D REINDEX ;reindex Provider Taxonomy file
D TPCODES ;fix entries 1-9 to be 01-09 and re-index
I $G(^DD(9002274.3021,.18,0))="" D ^ABMPRVCV ;convert provider to multiple for claims and bills; only do once
D NEWCRSN ;new canceled claim reasons
Q
ERRCODES ;
;215 - supervising provider missing ID#
K DIC,X
S DIC="^ABMDERR("
S DIC(0)="LM"
S DINUM=215
S X="SUPERVISING PROVIDER MISSING ID NUMBER"
S DIC("DR")=".02///Edit Supervising Provider on page 3 and enter UPIN"
S DIC("DR")=DIC("DR")_";.03///E"
K DD,DO
D FILE^DICN
D SITE(215)
;198 - bill type must be ##5 if delayed reason code is other
K DIC,X
S DIC="^ABMDERR("
S DIC(0)="LM"
S DINUM=198
S X="BILL TYPE MUST BE ##5 IF DELAYED REASON CODE IS OTHER"
S DIC("DR")=".02///Change bill type or delayed reason code"
S DIC("DR")=DIC("DR")_";.03///W"
K DD,DO
D FILE^DICN
D SITE(198)
;214 - delayed reason code with no remarks
K DIC,X
S DIC="^ABMDERR("
S DIC(0)="LM"
S DINUM=214
S X="DELAYED REASON CODE WITH NO REMARKS"
S DIC("DR")=".02///Put remarks on page 9F"
S DIC("DR")=DIC("DR")_";.03///W"
K DD,DO
D FILE^DICN
D SITE(214)
;216 - provider on line item with no address
K DIC,X
S DIC="^ABMDERR("
S DIC(0)="LM"
S DINUM=216
S X="PROVIDER ON LINE ITEM WITH NO ADDRESS"
S DIC("DR")=".02///Add address for provider"
S DIC("DR")=DIC("DR")_";.03///E"
K DD,DO
D FILE^DICN
D SITE(216)
Q
SITE(ABMX) ;Add SITE multiple
S DUZHOLD=DUZ(2)
S DUZ(2)=0
F S DUZ(2)=$O(^ABMDCLM(DUZ(2))) Q:'+DUZ(2) D
.S DIC(0)="LX"
.S DA(1)=ABMX
.S DIC="^ABMDERR("_DA(1)_",31,"
.S DIC("P")=$P(^DD(9002274.04,31,0),U,2)
.S DINUM=DUZ(2)
.S X=$P($G(^DIC(4,DUZ(2),0)),U)
.S DIC("DR")=".03////E"
.D ^DIC
.K DA,DIC,DINUM
S DUZ(2)=DUZHOLD
K DUZHOLD,DLAYGO,ABMX
Q
EXPMUDT F ABMEXPM=3,14,15,22 D
.S ABMQUES=$P($G(^ABMDEXP(ABMEXPM,0)),U,8)
.Q:ABMQUES["25"
.S ABMQUES=ABMQUES_",25"
.S DIE="^ABMDEXP("
.S DA=ABMEXPM
.S DR=".08////"_ABMQUES
.D ^DIE
;
F ABMEXPM=21,51 D
.S ABMQUES=$P($G(^ABMDEXP(ABMEXPM,0)),U,8)
.Q:ABMQUES["31"
.S ABMQUES=ABMQUES_",31"
.S DIE="^ABMDEXP("
.S DA=ABMEXPM
.S DR=".08////"_ABMQUES
.D ^DIE
Q
XREF ;
K DIC,DIE,DR,DA,X,Y
S DUZHOLD=DUZ(2)
S DUZ(2)=0
F S DUZ(2)=$O(^ABMDTXST(DUZ(2))) Q:'+DUZ(2) D
.S DIK="^ABMDTXST(DUZ(2),"
.S DIK(1)=".16^C"
.D ENALL^DIK
S DUZ(2)=DUZHOLD
Q
ECODES ;
; IM14745
K DIC,X
S DIC="^ABMDCODE("
S DIC(0)="ML"
S X="07"
S DIC("DR")=".02///H"
S DIC("DR")=DIC("DR")_";.03///TRIBAL 638 FREE-STANDING FACILITY"
K DD,DO
D FILE^DICN
Q
K DIC,X
S DIC="^ABMDCODE("
S DIC(0)="ML"
S X="08"
S DIC("DR")=".02///H"
S DIC("DR")=DIC("DR")_";.03///TRIBAL 638 PROVIDER-BASED FACILITY"
K DD,DO
D FILE^DICN
Q
ZNODE ;
S DUZHOLD=DUZ(2)
S DUZ(2)=0
F S DUZ(2)=$O(^ABMDCLM(DUZ(2))) Q:'+DUZ(2) D
.S ABM("GL")="^ABMCCLMS(DUZ(2),0)"
.S @ABM("GL")=^DIC(9002274.32,0)
S DUZ(2)=DUZHOLD
K DUZHOLD,ABM
Q
TCODE ;
Q:'$D(^ABMPSTAT("B","Trancode missing"))
S ABMTCODE=$O(^ABMPSTAT("B","Trancode missing",0))
Q:ABMTCODE=0
S DIE="^ABMPSTAT("
S DA=ABMTCODE
S DR=".01////Transcode missing"
D ^DIE
Q
QUES ;
K DIC,X,DINUM,DR,DLAYGO
S DIC="^ABMQUES("
S DIC(0)="LM"
S DLAYGO=9002274
S DINUM=31,X="DELAYED REASON CODE"
S DIC("DR")=".02////W31;.03////ABMDE30;.04////31;1////ABMDE3C"
K DD,DO
D ^DIC
Q
POSTF ;
S ABMBDFN=0
F S ABMBDFN=$O(^ABMDBILL(DUZ(2),ABMBDFN)) Q:+ABMBDFN=0 D
.Q:$P($G(^ABMDBILL(DUZ(2),ABMBDFN,0)),U,7)'=901 ;not POS claim
.S DIE="ABMDBILL(DUZ(2),"
.S DA=ABMBDFN
.S DR=".06////24"
.D ^DIE
Q
NEWVT ;
;new visit type for Immunization for task 2
K DIC,X,DINUM,DR,DLAYGO
S DIC="^ABMDVTYP("
S DIC(0)="LM"
S X="IMMUNIZATION"
S DINUM=140
D ^DIC
Q
REINDEX ;EP
K DIK,DA,DR,DIE,DIC
S DIK="^ABMPTAX("
D IXALL^DIK
Q
TPCODES ;
S ABMCODE=""
F S ABMCODE=$O(^ABMDCODE("AC","O",ABMCODE)) Q:ABMCODE="" D
.Q:$L(ABMCODE)>1 ;only want 1-digit occurrence codes
.S ABMCIEN=$O(^ABMDCODE("AC","O",ABMCODE,0))
.Q:+ABMCIEN=0
.S DIE="^ABMDCODE("
.S DA=ABMCIEN
.S DR=".01////0"_ABMCODE
.D ^DIE
S DIK="^ABMDCODE("
S DIK(1)=".02^AC"
D ENALL^DIK
Q
NEWCRSN ;
K DIC,X,DINUM,DR,DLAYGO
S DIC="^ABMCCLMR("
S DIC(0)="LM"
S X="RETURN TO STOCK"
D ^DIC
K DIC,X,DINUM,DR,DLAYGO
S DIC="^ABMCCLMR("
S DIC(0)="LM"
S X="OVER THE COUNTER MEDS"
D ^DIC
K DIC,X,DINUM,DR,DLAYGO
S DIC="^ABMCCLMR("
S DIC(0)="LM"
S X="LEFT WITHOUT BEING SEEN"
D ^DIC
K DIC,X,DINUM,DR,DLAYGO
S DIC="^ABMCCLMR("
S DIC(0)="LM"
S X="TELEPHONE CONSULT"
D ^DIC
Q
ABMPT259 ; IHS/ASDST/SDR - 3P BILLING 2.5 Patch 9 POST INIT ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ;
+4 QUIT
PREINST ;
+1 QUIT
EN ; EP
+1 ; add new error codes
DO ERRCODES
+2 ;update export mode with new questions
DO EXPMUDT
+3 ;index GROUP CONTROL NUMBER in 3P TX Status file
DO XREF
+4 ;add new 3P Codes
DO ECODES
+5 ;populate 0-node for 3P Cancelled Claims Data
DO ZNODE
+6 ;Change TRANCODE to TRANSCODE
DO TCODE
+7 ;add questions to 3P Page 3 Questions file
DO QUES
+8 ;populated export mode on past POS claims
DO POSTF
+9 ;new Visit Type for task 2
DO NEWVT
+10 ;reindex Provider Taxonomy file
DO REINDEX
+11 ;fix entries 1-9 to be 01-09 and re-index
DO TPCODES
+12 ;convert provider to multiple for claims and bills; only do once
IF $GET(^DD(9002274.3021,.18,0))=""
DO ^ABMPRVCV
+13 ;new canceled claim reasons
DO NEWCRSN
+14 QUIT
ERRCODES ;
+1 ;215 - supervising provider missing ID#
+2 KILL DIC,X
+3 SET DIC="^ABMDERR("
+4 SET DIC(0)="LM"
+5 SET DINUM=215
+6 SET X="SUPERVISING PROVIDER MISSING ID NUMBER"
+7 SET DIC("DR")=".02///Edit Supervising Provider on page 3 and enter UPIN"
+8 SET DIC("DR")=DIC("DR")_";.03///E"
+9 KILL DD,DO
+10 DO FILE^DICN
+11 DO SITE(215)
+12 ;198 - bill type must be ##5 if delayed reason code is other
+13 KILL DIC,X
+14 SET DIC="^ABMDERR("
+15 SET DIC(0)="LM"
+16 SET DINUM=198
+17 SET X="BILL TYPE MUST BE ##5 IF DELAYED REASON CODE IS OTHER"
+18 SET DIC("DR")=".02///Change bill type or delayed reason code"
+19 SET DIC("DR")=DIC("DR")_";.03///W"
+20 KILL DD,DO
+21 DO FILE^DICN
+22 DO SITE(198)
+23 ;214 - delayed reason code with no remarks
+24 KILL DIC,X
+25 SET DIC="^ABMDERR("
+26 SET DIC(0)="LM"
+27 SET DINUM=214
+28 SET X="DELAYED REASON CODE WITH NO REMARKS"
+29 SET DIC("DR")=".02///Put remarks on page 9F"
+30 SET DIC("DR")=DIC("DR")_";.03///W"
+31 KILL DD,DO
+32 DO FILE^DICN
+33 DO SITE(214)
+34 ;216 - provider on line item with no address
+35 KILL DIC,X
+36 SET DIC="^ABMDERR("
+37 SET DIC(0)="LM"
+38 SET DINUM=216
+39 SET X="PROVIDER ON LINE ITEM WITH NO ADDRESS"
+40 SET DIC("DR")=".02///Add address for provider"
+41 SET DIC("DR")=DIC("DR")_";.03///E"
+42 KILL DD,DO
+43 DO FILE^DICN
+44 DO SITE(216)
+45 QUIT
SITE(ABMX) ;Add SITE multiple
+1 SET DUZHOLD=DUZ(2)
+2 SET DUZ(2)=0
+3 FOR
SET DUZ(2)=$ORDER(^ABMDCLM(DUZ(2)))
IF '+DUZ(2)
QUIT
Begin DoDot:1
+4 SET DIC(0)="LX"
+5 SET DA(1)=ABMX
+6 SET DIC="^ABMDERR("_DA(1)_",31,"
+7 SET DIC("P")=$PIECE(^DD(9002274.04,31,0),U,2)
+8 SET DINUM=DUZ(2)
+9 SET X=$PIECE($GET(^DIC(4,DUZ(2),0)),U)
+10 SET DIC("DR")=".03////E"
+11 DO ^DIC
+12 KILL DA,DIC,DINUM
End DoDot:1
+13 SET DUZ(2)=DUZHOLD
+14 KILL DUZHOLD,DLAYGO,ABMX
+15 QUIT
EXPMUDT FOR ABMEXPM=3,14,15,22
Begin DoDot:1
+1 SET ABMQUES=$PIECE($GET(^ABMDEXP(ABMEXPM,0)),U,8)
+2 IF ABMQUES["25"
QUIT
+3 SET ABMQUES=ABMQUES_",25"
+4 SET DIE="^ABMDEXP("
+5 SET DA=ABMEXPM
+6 SET DR=".08////"_ABMQUES
+7 DO ^DIE
End DoDot:1
+8 ;
+9 FOR ABMEXPM=21,51
Begin DoDot:1
+10 SET ABMQUES=$PIECE($GET(^ABMDEXP(ABMEXPM,0)),U,8)
+11 IF ABMQUES["31"
QUIT
+12 SET ABMQUES=ABMQUES_",31"
+13 SET DIE="^ABMDEXP("
+14 SET DA=ABMEXPM
+15 SET DR=".08////"_ABMQUES
+16 DO ^DIE
End DoDot:1
+17 QUIT
XREF ;
+1 KILL DIC,DIE,DR,DA,X,Y
+2 SET DUZHOLD=DUZ(2)
+3 SET DUZ(2)=0
+4 FOR
SET DUZ(2)=$ORDER(^ABMDTXST(DUZ(2)))
IF '+DUZ(2)
QUIT
Begin DoDot:1
+5 SET DIK="^ABMDTXST(DUZ(2),"
+6 SET DIK(1)=".16^C"
+7 DO ENALL^DIK
End DoDot:1
+8 SET DUZ(2)=DUZHOLD
+9 QUIT
ECODES ;
+1 ; IM14745
+2 KILL DIC,X
+3 SET DIC="^ABMDCODE("
+4 SET DIC(0)="ML"
+5 SET X="07"
+6 SET DIC("DR")=".02///H"
+7 SET DIC("DR")=DIC("DR")_";.03///TRIBAL 638 FREE-STANDING FACILITY"
+8 KILL DD,DO
+9 DO FILE^DICN
+10 QUIT
+11 KILL DIC,X
+12 SET DIC="^ABMDCODE("
+13 SET DIC(0)="ML"
+14 SET X="08"
+15 SET DIC("DR")=".02///H"
+16 SET DIC("DR")=DIC("DR")_";.03///TRIBAL 638 PROVIDER-BASED FACILITY"
+17 KILL DD,DO
+18 DO FILE^DICN
+19 QUIT
ZNODE ;
+1 SET DUZHOLD=DUZ(2)
+2 SET DUZ(2)=0
+3 FOR
SET DUZ(2)=$ORDER(^ABMDCLM(DUZ(2)))
IF '+DUZ(2)
QUIT
Begin DoDot:1
+4 SET ABM("GL")="^ABMCCLMS(DUZ(2),0)"
+5 SET @ABM("GL")=^DIC(9002274.32,0)
End DoDot:1
+6 SET DUZ(2)=DUZHOLD
+7 KILL DUZHOLD,ABM
+8 QUIT
TCODE ;
+1 IF '$DATA(^ABMPSTAT("B","Trancode missing"))
QUIT
+2 SET ABMTCODE=$ORDER(^ABMPSTAT("B","Trancode missing",0))
+3 IF ABMTCODE=0
QUIT
+4 SET DIE="^ABMPSTAT("
+5 SET DA=ABMTCODE
+6 SET DR=".01////Transcode missing"
+7 DO ^DIE
+8 QUIT
QUES ;
+1 KILL DIC,X,DINUM,DR,DLAYGO
+2 SET DIC="^ABMQUES("
+3 SET DIC(0)="LM"
+4 SET DLAYGO=9002274
+5 SET DINUM=31
SET X="DELAYED REASON CODE"
+6 SET DIC("DR")=".02////W31;.03////ABMDE30;.04////31;1////ABMDE3C"
+7 KILL DD,DO
+8 DO ^DIC
+9 QUIT
POSTF ;
+1 SET ABMBDFN=0
+2 FOR
SET ABMBDFN=$ORDER(^ABMDBILL(DUZ(2),ABMBDFN))
IF +ABMBDFN=0
QUIT
Begin DoDot:1
+3 ;not POS claim
IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMBDFN,0)),U,7)'=901
QUIT
+4 SET DIE="ABMDBILL(DUZ(2),"
+5 SET DA=ABMBDFN
+6 SET DR=".06////24"
+7 DO ^DIE
End DoDot:1
+8 QUIT
NEWVT ;
+1 ;new visit type for Immunization for task 2
+2 KILL DIC,X,DINUM,DR,DLAYGO
+3 SET DIC="^ABMDVTYP("
+4 SET DIC(0)="LM"
+5 SET X="IMMUNIZATION"
+6 SET DINUM=140
+7 DO ^DIC
+8 QUIT
REINDEX ;EP
+1 KILL DIK,DA,DR,DIE,DIC
+2 SET DIK="^ABMPTAX("
+3 DO IXALL^DIK
+4 QUIT
TPCODES ;
+1 SET ABMCODE=""
+2 FOR
SET ABMCODE=$ORDER(^ABMDCODE("AC","O",ABMCODE))
IF ABMCODE=""
QUIT
Begin DoDot:1
+3 ;only want 1-digit occurrence codes
IF $LENGTH(ABMCODE)>1
QUIT
+4 SET ABMCIEN=$ORDER(^ABMDCODE("AC","O",ABMCODE,0))
+5 IF +ABMCIEN=0
QUIT
+6 SET DIE="^ABMDCODE("
+7 SET DA=ABMCIEN
+8 SET DR=".01////0"_ABMCODE
+9 DO ^DIE
End DoDot:1
+10 SET DIK="^ABMDCODE("
+11 SET DIK(1)=".02^AC"
+12 DO ENALL^DIK
+13 QUIT
NEWCRSN ;
+1 KILL DIC,X,DINUM,DR,DLAYGO
+2 SET DIC="^ABMCCLMR("
+3 SET DIC(0)="LM"
+4 SET X="RETURN TO STOCK"
+5 DO ^DIC
+6 KILL DIC,X,DINUM,DR,DLAYGO
+7 SET DIC="^ABMCCLMR("
+8 SET DIC(0)="LM"
+9 SET X="OVER THE COUNTER MEDS"
+10 DO ^DIC
+11 KILL DIC,X,DINUM,DR,DLAYGO
+12 SET DIC="^ABMCCLMR("
+13 SET DIC(0)="LM"
+14 SET X="LEFT WITHOUT BEING SEEN"
+15 DO ^DIC
+16 KILL DIC,X,DINUM,DR,DLAYGO
+17 SET DIC="^ABMCCLMR("
+18 SET DIC(0)="LM"
+19 SET X="TELEPHONE CONSULT"
+20 DO ^DIC
+21 QUIT
