ABMPT268 ; IHS/SD/SDR - 3P BILLING 2.6 Patch 8 POST INIT ;
;;2.6;IHS Third Party Billing;**8**;NOV 12, 2009
;
Q
POST ;
D EXP31
D EXP33
D ERRCODES
D PRVCLASS
D CHRGSUMM
D MUCONV
Q
EXP31 ;
K DIC,DR,DINUM,DLAYGO,DIE
S DIC="^ABMDEXP("
S DIC(0)="LM"
S DLAYGO=9002274
S X="837I (UB) 5010",DINUM=31
K DD,DO
D ^DIC
Q:Y<0
S DA=+Y
S DIE="^ABMDEXP("
S DR=".04////ABMEF31;.07///837 5010 INSTITUTIONAL;.08///1,2,3,4,5,6,8,14,19,21,22,23,24,28,31;.11////ABMDES1;.15///E"
D ^DIE
EXP33 ;
K DIC,DR,DINUM,DLAYGO,DIE
S DIC="^ABMDEXP("
S DIC(0)="LM"
S DLAYGO=9002274
S X="837D (ADA) 5010",DINUM=33
K DD,DO
D ^DIC
Q:Y<0
S DA=+Y
S DIE="^ABMDEXP("
S DR=".04////ABMEF33;.07///837 5010 DENTAL;.08///1,2,3,4B,5,14,16,17,18,19,28,34,35;.11////ABMDES3;.15///E"
D ^DIE
Q
ERRCODES ;
;240 - POA VALUE '1' NOT APPLICABLE FOR THIS EXPORT MODE
K DIC,X
S DIC="^ABMDERR("
S DIC(0)="LM"
S DINUM=240
S X="POA VALUE '1' NOT APPLICABLE FOR THIS EXPORT MODE"
S DIC("DR")=".02///Select different POA Value"
S DIC("DR")=DIC("DR")_";.03///E"
K DD,DO
D FILE^DICN
D SITE(240)
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
;
PRVCLASS ;
F ABMI=1:1 S ABMLN=$P($T(PCLASS+ABMI),";;",2) Q:ABMLN="END" D
.S DA(1)=1
.S DIC="^ABMMUPRM("_DA(1)_",2,"
.S DIC(0)="QLM"
.S X=$P(ABMLN,U)
.D ^DIC
Q
PCLASS ;
;;00^PHYSICIAN
;;11^PHYSICIAN ASSISTANT
;;16^PEDIATRIC NURSE PRACT.
;;17^NURSE MIDWIFE
;;18^PHYSICIAN (CONTRACT)
;;21^NURSE PRACTITIONER
;;41^OB/GYN (CONTRACT)
;;44^PHYSICIAN (TRIBAL)
;;45^OSTEOPATH
;;49^CONTRACT PSYCHIATRIST
;;52^DENTIST
;;64^NEPHROLOGIST
;;68^EMERGENCY ROOM PHYSICIAN
;;70^CARDIOLOGIST
;;71^INTERNAL MEDICINE
;;72^OB/GYN
;;73^ORTHOPEDIST
;;74^OTOLARYNGOLOGIST
;;75^PEDIATRICIAN
;;76^RADIOLOGIST
;;77^SURGEON
;;78^UROLOGIST
;;79^OPHTHALMOLOGIST
;;80^FAMILY PRACTICE
;;81^PSYCHIATRIST
;;82^ANESTHESIOLOGIST
;;83^PATHOLOGIST
;;85^NEUROLOGIST
;;86^DERMATOLOGIST
;;A1^SPORTS MEDICINE PHYSICIAN
;;A9^HEPATOLOGIST
;;B1^GASTROENTEROLOGIST
;;B2^ENDOCRINOLOGIST
;;B3^RHEUMATOLOGIST
;;B4^ONCOLOGIST-HEMATOLOGIST
;;B5^PULMONOLOGIST
;;B6^NEUROSURGEON
;;END
CHRGSUMM ;
S DIE="^ABMDEXP("
S DR=".11////ABMDES4"
F DA=23,33 D
.D ^DIE
Q
MUCONV ;
S ABMIEN=0
F S ABMIEN=$O(^ABMMUPRM(1,1,ABMIEN)) Q:'ABMIEN D
.S ABMLOC=+$P($G(^ABMMUPRM(1,1,ABMIEN,0)),U)
.Q:'$D(^ABMMUPRM(1,1,ABMLOC))
.S $P(^ABMMUPRM(1,1,ABMIEN,0),U,2)=$P($G(^ABMMUPRM(1,1,ABMLOC,0)),U,2)
.S DA(1)=1
.S DA=ABMLOC
.S DIK="^ABMMUPRM("_DA(1)_",1,"
.D ^DIK
Q
ABMPT268 ; IHS/SD/SDR - 3P BILLING 2.6 Patch 8 POST INIT ;
+1 ;;2.6;IHS Third Party Billing;**8**;NOV 12, 2009
+2 ;
+3 QUIT
POST ;
+1 DO EXP31
+2 DO EXP33
+3 DO ERRCODES
+4 DO PRVCLASS
+5 DO CHRGSUMM
+6 DO MUCONV
+7 QUIT
EXP31 ;
+1 KILL DIC,DR,DINUM,DLAYGO,DIE
+2 SET DIC="^ABMDEXP("
+3 SET DIC(0)="LM"
+4 SET DLAYGO=9002274
+5 SET X="837I (UB) 5010"
SET DINUM=31
+6 KILL DD,DO
+7 DO ^DIC
+8 IF Y<0
QUIT
+9 SET DA=+Y
+10 SET DIE="^ABMDEXP("
+11 SET DR=".04////ABMEF31;.07///837 5010 INSTITUTIONAL;.08///1,2,3,4,5,6,8,14,19,21,22,23,24,28,31;.11////ABMDES1;.15///E"
+12 DO ^DIE
EXP33 ;
+1 KILL DIC,DR,DINUM,DLAYGO,DIE
+2 SET DIC="^ABMDEXP("
+3 SET DIC(0)="LM"
+4 SET DLAYGO=9002274
+5 SET X="837D (ADA) 5010"
SET DINUM=33
+6 KILL DD,DO
+7 DO ^DIC
+8 IF Y<0
QUIT
+9 SET DA=+Y
+10 SET DIE="^ABMDEXP("
+11 SET DR=".04////ABMEF33;.07///837 5010 DENTAL;.08///1,2,3,4B,5,14,16,17,18,19,28,34,35;.11////ABMDES3;.15///E"
+12 DO ^DIE
+13 QUIT
ERRCODES ;
+1 ;240 - POA VALUE '1' NOT APPLICABLE FOR THIS EXPORT MODE
+2 KILL DIC,X
+3 SET DIC="^ABMDERR("
+4 SET DIC(0)="LM"
+5 SET DINUM=240
+6 SET X="POA VALUE '1' NOT APPLICABLE FOR THIS EXPORT MODE"
+7 SET DIC("DR")=".02///Select different POA Value"
+8 SET DIC("DR")=DIC("DR")_";.03///E"
+9 KILL DD,DO
+10 DO FILE^DICN
+11 DO SITE(240)
+12 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
+16 ;
PRVCLASS ;
+1 FOR ABMI=1:1
SET ABMLN=$PIECE($TEXT(PCLASS+ABMI),";;",2)
IF ABMLN="END"
QUIT
Begin DoDot:1
+2 SET DA(1)=1
+3 SET DIC="^ABMMUPRM("_DA(1)_",2,"
+4 SET DIC(0)="QLM"
+5 SET X=$PIECE(ABMLN,U)
+6 DO ^DIC
End DoDot:1
+7 QUIT
PCLASS ;
+1 ;;00^PHYSICIAN
+2 ;;11^PHYSICIAN ASSISTANT
+3 ;;16^PEDIATRIC NURSE PRACT.
+4 ;;17^NURSE MIDWIFE
+5 ;;18^PHYSICIAN (CONTRACT)
+6 ;;21^NURSE PRACTITIONER
+7 ;;41^OB/GYN (CONTRACT)
+8 ;;44^PHYSICIAN (TRIBAL)
+9 ;;45^OSTEOPATH
+10 ;;49^CONTRACT PSYCHIATRIST
+11 ;;52^DENTIST
+12 ;;64^NEPHROLOGIST
+13 ;;68^EMERGENCY ROOM PHYSICIAN
+14 ;;70^CARDIOLOGIST
+15 ;;71^INTERNAL MEDICINE
+16 ;;72^OB/GYN
+17 ;;73^ORTHOPEDIST
+18 ;;74^OTOLARYNGOLOGIST
+19 ;;75^PEDIATRICIAN
+20 ;;76^RADIOLOGIST
+21 ;;77^SURGEON
+22 ;;78^UROLOGIST
+23 ;;79^OPHTHALMOLOGIST
+24 ;;80^FAMILY PRACTICE
+25 ;;81^PSYCHIATRIST
+26 ;;82^ANESTHESIOLOGIST
+27 ;;83^PATHOLOGIST
+28 ;;85^NEUROLOGIST
+29 ;;86^DERMATOLOGIST
+30 ;;A1^SPORTS MEDICINE PHYSICIAN
+31 ;;A9^HEPATOLOGIST
+32 ;;B1^GASTROENTEROLOGIST
+33 ;;B2^ENDOCRINOLOGIST
+34 ;;B3^RHEUMATOLOGIST
+35 ;;B4^ONCOLOGIST-HEMATOLOGIST
+36 ;;B5^PULMONOLOGIST
+37 ;;B6^NEUROSURGEON
+38 ;;END
CHRGSUMM ;
+1 SET DIE="^ABMDEXP("
+2 SET DR=".11////ABMDES4"
+3 FOR DA=23,33
Begin DoDot:1
+4 DO ^DIE
End DoDot:1
+5 QUIT
MUCONV ;
+1 SET ABMIEN=0
+2 FOR
SET ABMIEN=$ORDER(^ABMMUPRM(1,1,ABMIEN))
IF 'ABMIEN
QUIT
Begin DoDot:1
+3 SET ABMLOC=+$PIECE($GET(^ABMMUPRM(1,1,ABMIEN,0)),U)
+4 IF '$DATA(^ABMMUPRM(1,1,ABMLOC))
QUIT
+5 SET $PIECE(^ABMMUPRM(1,1,ABMIEN,0),U,2)=$PIECE($GET(^ABMMUPRM(1,1,ABMLOC,0)),U,2)
+6 SET DA(1)=1
+7 SET DA=ABMLOC
+8 SET DIK="^ABMMUPRM("_DA(1)_",1,"
+9 DO ^DIK
End DoDot:1
+10 QUIT
