ABMDE3C ; IHS/ASDST/DMJ - Edit Page 3 - QUESTIONS - part 4 ;
;;2.6;IHS 3P BILLING SYSTEM;**6,10,13,14,21**;NOV 12, 2009;Build 379
;IHS/SD/SDR 2.5*6-7/14/04-IM14117 - Modified code to prompt for either
; Person Class, Provider Class, or taxonomy code. One of the three must be entered
;IHS/SD/SDR 2.5*8-IM14016/IM15234/IM15615 - Fix Prior Authorization field
;IHS/SD/SDR 2.5*8-IM14693/IM16105 - Added code for Number of Enclosures (32)
;IHS/SD/SDR-2.5*8-IM12246/IM17548 - Added Reference and In-House CLIA Numbers
;IHS/SD/SDR-2.5*9-IM19291 - Supervising provider and UPIN
;IHS/SD/SDR-2.5*9-IM18516 - Delayed Reason Code
;IHS/SD/SDR-2.5*9-IM19062 - allow employment related to be "N"
;IHS/SD/SDR 2.5*11-NPI
;IHS/SD/SDR-2.6*6-5010-added question 36 HEARING/VISION RX DATE
;IHS/SD/SDR-2.6*6-5010-added start/end disability dates
;IHS/SD/SDR-2.6*6-5010-added assumed/relinquished care dates
;IHS/SD/SDR-2.6*6-5010-added property/casualty date of 1st contact
;IHS/SD/SDR-2.6*6-5010-added patient paid amount
;IHS/SD/SDR-2.6*6-5010-added spinal manipulation cond code
;IHS/SD/SDR-2.6*6-5010-added vision condition info
;IHS/SD/SDR 2.6*13-ICD10 Added code to create/update 9A entry for Onset of Symptoms/Illness if
; Date of First Symptom is populated. They should both exist and be same date.
;IHS/SD/SDR 2.6*13-exp mode 35 -added Initial Treatment Date
;IHS/SD/SDR 2.6*13-Added acute manifestation date
;IHS/SD/SDR-2.6*13-Added Ord/Ref/Sup Phys FL17
;IHS/SD/SDR 2.6*14-ICD10 002E -Correction to screen for Admit DX.
;IHS/SD/SDR 2.6*14-HEAT163697 -Added quit to stop edits for referring provider to happen if prv was deleted.
;IHS/SD/SDR 2.6*14-HEAT163737 -for ref/ord/sup phys remove provider type is provider name is deleted.
;IHS/SD/SDR 2.6*14-HEAT163740 -Added default to Admit Dx if it was previously populated.
;IHS/SD/SDR 2.6*14-HEAT165301 -Removed link to page 9A for Date of First Symptom
;IHS/SD/SDR 2.6*21 - HEAT159770 - Made lookup for employment related use '02' not '2'
;**********************************************************************
;
9 W ! S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".86["_ABM("#")_"] Date of First Symptom" D ^DIE K DR
I X>ABMP("VDT") W *7,!!,"ERROR: Date can not be after the Visit Date (",$$HDT^ABMDUTL(ABMP("VDT")),")!" S DR=".86///@" D ^DIE G 9
;abm*2.6*14 HEAT165301 removed new to populate page 9A
;start new abm*2.6*13 ICD10 new export mode 35
;S ABMTEST=+$O(^ABMDCODE("AC","O",11,0))
;S ABMI=0
;F S ABMI=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),51,ABMI)) Q:'ABMI D
;.I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),51,ABMI,0)),U)'=ABMTEST Q
;.D ^XBFMK
;.S DA(1)=ABMP("CDFN")
;.S DA=ABMI
;.S DIK="^ABMDCLM(DUZ(2),"_DA(1)_",51,"
;.D ^DIK
;I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,6)="" Q
;K ABMTEST,ABMI
;D ^XBFMK
;S DA(1)=ABMP("CDFN")
;S DIC="^ABMDCLM(DUZ(2),"_DA(1)_",51,"
;S DIC("P")=$P(^DD(9002274.3,51,0),U,2)
;S X=+$O(^ABMDCODE("AC","O",11,0))
;S DIC(0)="ML"
;K DD,DO
;D FILE^DICN
;S DIE=DIC
;S DA=+Y
;S DR=".02////"_$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,6)
;D ^DIE
;end new ICD10 new export mode
Q
;
11 W ! S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".87["_ABM("#")_"] Date First Consulted for this Condition" D ^DIE K DR
I X>ABMP("VDT") W *7,!!,"ERROR: Date can not be after the Visit Date (",$$HDT^ABMDUTL(ABMP("VDT")),")!" S DR=".87///@" D ^DIE G 11
Q
;
12 W ! S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".88["_ABM("#")_"] Name of Referring Physician" D ^DIE
I X="",$P($G(^ABMDCLM(DUZ(2),DA,8)),U,11)]"" S DR=".884///@;.885///@;.886///@;.887///@;.888///@;.889///@" D ^DIE Q
;I X]"",$E(ABM("QU"),$L(ABM("QU")))="B" D ;abm*2.6*10 found while testing
;removed 1 dot for all lines below in this TAG
S ABMNPIU=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
I ABMNPIU="B"!(ABMNPIU="N") D
.S DR=".889 Referring Physician NPI"
.D ^DIE
I ABMNPIU'="N" D
.S DR=".884 Referring Physician ID Qualifier"
.S DR=DR_";.885 Referring Physician I.D. No"
.D ^DIE
I $P($G(^ABMDCLM(DUZ(2),DA,8)),U,11)'="" D ;only ask if UPIN was entered
.S ABMTXFLG=0
.I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,13)'="" D ;Person Class
..W !!,"Person Class already entered: ",$P($G(^USC(8932.1,$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,13),0)),U)
..S ABMTXFLG=1
.I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,14)'="" D ;Provider Class
..W !!,"Provider Class already entered: ",$P($G(^DIC(7,$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,14),9999999)),U)_" "_$P($G(^DIC(7,$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,14),0)),U)
..S ABMTXFLG=1
.I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,15)'="" D ;Taxonomy Code
..W !!,"Taxonomy Code already entered: ",$P($G(^ABMPTAX($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,15),0)),U)
..S ABMTXFLG=1
.F D Q:ABMTXFLG=1
..S DIR(0)="SO^1:Person Class;2:Provider Class;3:Taxonomy Code"
..S DIR("A")="Which would you like to enter?"
..D ^DIR K DIR
..I Y=1 D Q ;Person Class
...S DR=".887////@;.888////@;.886 Referring Physician Person Class..:"
...D ^DIE
...I X'="" S ABMTXFLG=1
..I Y=2 D Q ;Provider Class
...S DR=".886////@;.888////@;.887 Referring Physician Provider Class..:"
...D ^DIE
...I X'="" S ABMTXFLG=1
..I Y=3 D Q ;Taxonomy code
...S DR=".886////@;.887////@;.888 Referring Physician Taxonomy Code..:"
...D ^DIE
...I X'="" S ABMTXFLG=1
K DR
Q
;
10 W ! S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".89["_ABM("#")_"] Similiar Illness or Injury Date" D ^DIE K DR
I X>ABMP("VDT") W *7,!!,"ERROR: Date can not be after the Visit Date (",$$HDT^ABMDUTL(ABMP("VDT")),")!" S DR=".89///@" D ^DIE G 10
Q
;
4 K DIR W ! S DIR(0)="Y",DIR("A")="["_ABM("#")_"] Was Visit Employment Related",DIR("?")="Was the Reason for the Visit Related to Employment"
I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),$P(^(9),U,1)="Y" S DIR("B")="Y"
E S DIR("B")="N"
D ^DIR K DIR
Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S ABM("Y")=Y
I Y=1 G EMCODE
I ABM("Y")=0,$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),$P(^(9),U,1)="Y" S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".91///@;.92///@;.93///@;.94///@;.95///@;.96///@" D ^DIE K DR
Q:($D(^ABMDCLM(DUZ(2),ABMP("CDFN"),53,0))<10)
S DA(1)=ABMP("CDFN"),DIK="^ABMDCLM(DUZ(2),"_DA(1)_",53,",DA=$O(^ABMDCODE("AC","C",2,"")) D ^DIK
Q
EMCODE ;
;S (DINUM,X)=$O(^ABMDCODE("AC","C",2,"")) Q:X="" ;abm*2.6*21 IHS/SD/SDR HEAT159770
S (DINUM,X)=$O(^ABMDCODE("AC","C","02","")) Q:X="" ;abm*2.6*21 IHS/SD/SDR HEAT159770
K DD,DO S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_",53,",DIC(0)="LE"
I '$D(^ABMDCLM(DUZ(2),DA(1),53,0)) S ^ABMDCLM(DUZ(2),DA(1),53,0)="^9002274.3053P^^"
D FILE^DICN K DIC
S DR=".91////Y",DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN") W !
I "AB"'[$E(ABM("QU"),$L(ABM("QU"))) G ESET
I $E(ABM("QU"),$L(ABM("QU")))="B" S DR=DR_";.93Unable to Work From Date...: ;I X="""" S Y=""@9"";.94Unable to Work Thru Date...: ;@9"
E S DR=DR_";.92T;.93T;I X="""" S Y=.95;.94T;.95T;I X="""" S Y=""@9"";.96T;@9"
ESET D ^DIE K DR
Q
;
13 ;
Q
;
14 W ! S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".48["_ABM("#")_"] Assigned Case Number" D ^DIE K DR
Q
;
15 W ! S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".49["_ABM("#")_"] Medicaid Resubmission No." D ^DIE K DR
Q
;
16 W ! S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".43["_ABM("#")_"] Number Radiographs Submitted" D ^DIE K DR
Q
;
17 W ! S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".44["_ABM("#")_"] Orthodontic Related" D ^DIE K DR
Q:X'=1
S DR=".45 Placement Date" D ^DIE
S DR="413 Months of Treatment Remaining:" D ^DIE
I X>ABMP("VDT") W *7,!!,"ERROR: Date can not be after the Visit Date (",$$HDT^ABMDUTL(ABMP("VDT")),")!" S DR=".45///@" D ^DIE G 17
Q
;
18 W ! S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".46["_ABM("#")_"] Init. Prosthesis Placed" D ^DIE K DR
I X=0 S DR=".47 Prior Placement Date" D ^DIE
Q
;
19 W ! S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".58["_ABM("#")_"] Peer Review Organization (PRO) Approval No." D ^DIE K DR
Q
20 ;HCFA-1500B BLOCK 19
S $P(ABM("-"),"-",49)="" W !,?15,ABM("-")
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR="10["_ABM("#")_"] Block 19" D ^DIE K DR
Q
21 ;TYPE OF ADMISSION
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".51["_ABM("#")_"] Admission Type" D ^DIE
Q
22 ;SOURCE OF ADMISSION
S:'$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)) ^(5)=""
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".52["_ABM("#")_"] Admission Source" D ^DIE
Q
23 ;DISCHARGE STATUS
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".53["_ABM("#")_"]Discharge Status" D ^DIE
Q
24 ;Admitting DX
W !,"** CODING SYSTEM IS "_$S(ABMP("VDT")<ABMP("ICD10"):"ICD-9",1:"ICD-10")_" **" ;abm*2.6*10 ICD10 002E
;start old abm*2.6*14 ICD10 002E
;start new abm*2.6*10 ICD10 002E
;I $D(^ROUTINE("ICDSAPI")) D Q
;.W !,"["_ABM("#")_"] Admitting DX"
;.S ABMFLD=+$$SEARCH^ICDSAPI("DIAG",,,$S($G(ABMP("ICD10")):ABMP("ICD10"),$G(ABMP("VDT")):ABMP("VDT"),1:DT))
;.I ABMFLD>0 S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=ABMFLD D ^DIE
;end new code ICD10 002E
;S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".59["_ABM("#")_"] Admitting DX" D ^DIE
;end old start new ICD10 002E
K DIR,DR,X,Y
S DIR(0)="PO^80:QEAM"
I ABMP("VDT")<ABMP("ICD10") S DIR("S")="I $P($$DX^ABMCVAPI(+Y),U,20)'=30"
I '(ABMP("VDT")<ABMP("ICD10")) S DIR("S")="I $P($$DX^ABMCVAPI(+Y),U,20)=30"
S DIR("A")="["_ABM("#")_"] Admitting DX"
S:(+$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U,9)) DIR("B")=$P($$DX^ABMCVAPI(+$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U,9)),U,2) ;abm*2.6*14 HEAT163740
D ^DIR
I X="@" S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".59////@" D ^DIE
Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".59////"_+Y D ^DIE
;end new ICD10 002E
Q
25 ; Supervising Prov (FL19)
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".912["_ABM("#")_"] Supervising Prov.(FL19)" D ^DIE
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".911["_ABM("#")_"] Date Last Seen" D ^DIE
S ABMNPIU=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
I ABMNPIU="B"!(ABMNPIU="N") D
.S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR="925["_ABM("#")_"] NPI" D ^DIE
I ABMNPIU'="N" D
.S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR="924["_ABM("#")_"] I.D. Number (UPIN)" D ^DIE
Q
26 ; Date of Last X-Ray
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".913["_ABM("#")_"] Date of Last X-Ray" D ^DIE
Q
27 ;Referral Number
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".511["_ABM("#")_"] Referral Number" D ^DIE
Q
28 ;Prior Authorization Number
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".512["_ABM("#")_"] Prior Authorizaion Number" D ^DIE
Q
29 ;Homebound Indicator
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".914["_ABM("#")_"] Homebound Indicator" D ^DIE
Q
30 ;Hospice Employed Provider
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".915["_ABM("#")_"] Hospice Employed Provider" D ^DIE
Q
31 ;Delayed Reason Code
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".916["_ABM("#")_"] Delayed Reason Code" D ^DIE
Q
32 ;#Enclosures - Radiographs/Oral Images/Models
W !,"Number of Enclosures: ",!
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".917 Radiographs" D ^DIE
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".918 Oral Images" D ^DIE
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".919 Models" D ^DIE
Q
33 ;Other Dental Charges
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".921["_ABM("#")_"] Other Dental Charges" D ^DIE
Q
34 ;Reference Lab CLIA#
N ABMDCLIA
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN")
S ABMDCLIA=$P($G(^ABMDPARM(DUZ(2),1,4)),U,12)
I ABMDCLIA'="" S ABMDCLIA=$P($G(^ABMRLABS(ABMDCLIA,0)),U)
I ABMDCLIA'="" S ABMDCLIA=$P($G(^AUTTVNDR(ABMDCLIA,0)),U)
S DR=".923"_$S(ABMDCLIA'="":"//"_ABMDCLIA,1:"")
D ^DIE
K ABMDCLIA
Q
35 ;In-House CLIA#
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".922["_ABM("#")_"] In-House CLIA#: //"_$P($G(^ABMDPARM(DUZ(2),1,4)),U,11) D ^DIE
Q
;start new abm*2.6*6 5010
36 ;Hearing and Vision Prescription Date
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".714["_ABM("#")_"] Hearing/Vision Prescription Date: //" D ^DIE
Q
37 ;Start/End Disability Dates
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN")
S DR=".715["_ABM("#")_"] Start Disability Date: //" D ^DIE
S DR=".716["_ABM("#")_"] End Disability Date: //" D ^DIE
Q
38 ;Assumed/Relinquished Care Dates
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN")
S DR=".719["_ABM("#")_"] Assumed Care Date: //" D ^DIE
S DR=".721["_ABM("#")_"] Relinquished Care Date: //" D ^DIE
Q
39 ;Property/Casualty Date of 1st contact
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".722["_ABM("#")_"] Property/Casualty Date of 1st Contact: //" D ^DIE
Q
40 ;Patient Paid Amount
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".723["_ABM("#")_"] Patient Paid Amount: //" D ^DIE
Q
41 ;Spinal Manipulation Cond Code
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".724["_ABM("#")_"] Spinal Manipulation Cond Code Ind: //" D ^DIE
;start new abm*2.6*13 exp mode 35
I "^A^M^"[("^"_$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,24)_"^") S DR=".727 Acute Manifestation Date: //" D ^DIE
I "^A^M^"'[("^"_$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,24)_"^") S DR=".727////@" D ^DIE
;end new exp mode 35
Q
42 ; Vision Condition Info
S DIE="^ABMDCLM(DUZ(2),"
S DA=ABMP("CDFN")
S DR=".821["_ABM("#")_"] Vision Condition Info: //"
S DR=DR_";W !?3;.822 Vision Certification Condition Indicator: //"
D ^DIE
F D Q:Y<0
.K DIC,DIE,DIR,X,Y,DA
.S DA(1)=ABMP("CDFN")
.S DIC="^ABMDCLM(DUZ(2),"_DA(1)_",8.5,"
.S DIC(0)="AQELM"
.S DIC("P")=$P(^DD(9002274.3,8.5,0),U,2)
.D ^DIC
Q
;end new 5010
;start new abm*2.6*13 exp mode 35
43 ;Initial Treatment Date
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".823["_ABM("#")_"] Initial Treatment Date: //" D ^DIE
Q
44 ;Ord/Ref/Sup Phys (FL17)
S ABM("PROVIDER")=$$PRVLKUP^ABMDFUTL($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,24),$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,26))
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".824////"_$S($P(ABM("PROVIDER"),U)'="":$P(ABM("PROVIDER"),U),1:"@") D ^DIE
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".826////"_$S($P(ABM("PROVIDER"),U,2)'="":$P(ABM("PROVIDER"),U,2),1:"@") D ^DIE
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,24)="" S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".825////@" D ^DIE ;abm*2.6*14 HEAT163737
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,26)="" Q ;abm*2.6*14 HEAT163697
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,24)'="" S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DIE("NO^")=1,DR=".825R~Physician Type: //" D ^DIE
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,24)="" S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".825////@" D ^DIE
Q
;end new exp mode 35
ABMDE3C ; IHS/ASDST/DMJ - Edit Page 3 - QUESTIONS - part 4 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**6,10,13,14,21**;NOV 12, 2009;Build 379
+2 ;IHS/SD/SDR 2.5*6-7/14/04-IM14117 - Modified code to prompt for either
+3 ; Person Class, Provider Class, or taxonomy code. One of the three must be entered
+4 ;IHS/SD/SDR 2.5*8-IM14016/IM15234/IM15615 - Fix Prior Authorization field
+5 ;IHS/SD/SDR 2.5*8-IM14693/IM16105 - Added code for Number of Enclosures (32)
+6 ;IHS/SD/SDR-2.5*8-IM12246/IM17548 - Added Reference and In-House CLIA Numbers
+7 ;IHS/SD/SDR-2.5*9-IM19291 - Supervising provider and UPIN
+8 ;IHS/SD/SDR-2.5*9-IM18516 - Delayed Reason Code
+9 ;IHS/SD/SDR-2.5*9-IM19062 - allow employment related to be "N"
+10 ;IHS/SD/SDR 2.5*11-NPI
+11 ;IHS/SD/SDR-2.6*6-5010-added question 36 HEARING/VISION RX DATE
+12 ;IHS/SD/SDR-2.6*6-5010-added start/end disability dates
+13 ;IHS/SD/SDR-2.6*6-5010-added assumed/relinquished care dates
+14 ;IHS/SD/SDR-2.6*6-5010-added property/casualty date of 1st contact
+15 ;IHS/SD/SDR-2.6*6-5010-added patient paid amount
+16 ;IHS/SD/SDR-2.6*6-5010-added spinal manipulation cond code
+17 ;IHS/SD/SDR-2.6*6-5010-added vision condition info
+18 ;IHS/SD/SDR 2.6*13-ICD10 Added code to create/update 9A entry for Onset of Symptoms/Illness if
+19 ; Date of First Symptom is populated. They should both exist and be same date.
+20 ;IHS/SD/SDR 2.6*13-exp mode 35 -added Initial Treatment Date
+21 ;IHS/SD/SDR 2.6*13-Added acute manifestation date
+22 ;IHS/SD/SDR-2.6*13-Added Ord/Ref/Sup Phys FL17
+23 ;IHS/SD/SDR 2.6*14-ICD10 002E -Correction to screen for Admit DX.
+24 ;IHS/SD/SDR 2.6*14-HEAT163697 -Added quit to stop edits for referring provider to happen if prv was deleted.
+25 ;IHS/SD/SDR 2.6*14-HEAT163737 -for ref/ord/sup phys remove provider type is provider name is deleted.
+26 ;IHS/SD/SDR 2.6*14-HEAT163740 -Added default to Admit Dx if it was previously populated.
+27 ;IHS/SD/SDR 2.6*14-HEAT165301 -Removed link to page 9A for Date of First Symptom
+28 ;IHS/SD/SDR 2.6*21 - HEAT159770 - Made lookup for employment related use '02' not '2'
+29 ;**********************************************************************
+30 ;
9 WRITE !
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".86["_ABM("#")_"] Date of First Symptom"
DO ^DIE
KILL DR
+1 IF X>ABMP("VDT")
WRITE *7,!!,"ERROR: Date can not be after the Visit Date (",$$HDT^ABMDUTL(ABMP("VDT")),")!"
SET DR=".86///@"
DO ^DIE
GOTO 9
+2 ;abm*2.6*14 HEAT165301 removed new to populate page 9A
+3 ;start new abm*2.6*13 ICD10 new export mode 35
+4 ;S ABMTEST=+$O(^ABMDCODE("AC","O",11,0))
+5 ;S ABMI=0
+6 ;F S ABMI=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),51,ABMI)) Q:'ABMI D
+7 ;.I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),51,ABMI,0)),U)'=ABMTEST Q
+8 ;.D ^XBFMK
+9 ;.S DA(1)=ABMP("CDFN")
+10 ;.S DA=ABMI
+11 ;.S DIK="^ABMDCLM(DUZ(2),"_DA(1)_",51,"
+12 ;.D ^DIK
+13 ;I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,6)="" Q
+14 ;K ABMTEST,ABMI
+15 ;D ^XBFMK
+16 ;S DA(1)=ABMP("CDFN")
+17 ;S DIC="^ABMDCLM(DUZ(2),"_DA(1)_",51,"
+18 ;S DIC("P")=$P(^DD(9002274.3,51,0),U,2)
+19 ;S X=+$O(^ABMDCODE("AC","O",11,0))
+20 ;S DIC(0)="ML"
+21 ;K DD,DO
+22 ;D FILE^DICN
+23 ;S DIE=DIC
+24 ;S DA=+Y
+25 ;S DR=".02////"_$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,6)
+26 ;D ^DIE
+27 ;end new ICD10 new export mode
+28 QUIT
+29 ;
11 WRITE !
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".87["_ABM("#")_"] Date First Consulted for this Condition"
DO ^DIE
KILL DR
+1 IF X>ABMP("VDT")
WRITE *7,!!,"ERROR: Date can not be after the Visit Date (",$$HDT^ABMDUTL(ABMP("VDT")),")!"
SET DR=".87///@"
DO ^DIE
GOTO 11
+2 QUIT
+3 ;
12 WRITE !
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".88["_ABM("#")_"] Name of Referring Physician"
DO ^DIE
+1 IF X=""
IF $PIECE($GET(^ABMDCLM(DUZ(2),DA,8)),U,11)]""
SET DR=".884///@;.885///@;.886///@;.887///@;.888///@;.889///@"
DO ^DIE
QUIT
+2 ;I X]"",$E(ABM("QU"),$L(ABM("QU")))="B" D ;abm*2.6*10 found while testing
+3 ;removed 1 dot for all lines below in this TAG
+4 SET ABMNPIU=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
+5 IF ABMNPIU="B"!(ABMNPIU="N")
Begin DoDot:1
+6 SET DR=".889 Referring Physician NPI"
+7 DO ^DIE
End DoDot:1
+8 IF ABMNPIU'="N"
Begin DoDot:1
+9 SET DR=".884 Referring Physician ID Qualifier"
+10 SET DR=DR_";.885 Referring Physician I.D. No"
+11 DO ^DIE
End DoDot:1
+12 ;only ask if UPIN was entered
IF $PIECE($GET(^ABMDCLM(DUZ(2),DA,8)),U,11)'=""
Begin DoDot:1
+13 SET ABMTXFLG=0
+14 ;Person Class
IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,13)'=""
Begin DoDot:2
+15 WRITE !!,"Person Class already entered: ",$PIECE($GET(^USC(8932.1,$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,13),0)),U)
+16 SET ABMTXFLG=1
End DoDot:2
+17 ;Provider Class
IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,14)'=""
Begin DoDot:2
+18 WRITE !!,"Provider Class already entered: ",$PIECE($GET(^DIC(7,$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,14),9999999)),U)_" "_$PIECE($GET(^DIC(7,$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,14),0)),U)
+19 SET ABMTXFLG=1
End DoDot:2
+20 ;Taxonomy Code
IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,15)'=""
Begin DoDot:2
+21 WRITE !!,"Taxonomy Code already entered: ",$PIECE($GET(^ABMPTAX($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),8),U,15),0)),U)
+22 SET ABMTXFLG=1
End DoDot:2
+23 FOR
Begin DoDot:2
+24 SET DIR(0)="SO^1:Person Class;2:Provider Class;3:Taxonomy Code"
+25 SET DIR("A")="Which would you like to enter?"
+26 DO ^DIR
KILL DIR
+27 ;Person Class
IF Y=1
Begin DoDot:3
+28 SET DR=".887////@;.888////@;.886 Referring Physician Person Class..:"
+29 DO ^DIE
+30 IF X'=""
SET ABMTXFLG=1
End DoDot:3
QUIT
+31 ;Provider Class
IF Y=2
Begin DoDot:3
+32 SET DR=".886////@;.888////@;.887 Referring Physician Provider Class..:"
+33 DO ^DIE
+34 IF X'=""
SET ABMTXFLG=1
End DoDot:3
QUIT
+35 ;Taxonomy code
IF Y=3
Begin DoDot:3
+36 SET DR=".886////@;.887////@;.888 Referring Physician Taxonomy Code..:"
+37 DO ^DIE
+38 IF X'=""
SET ABMTXFLG=1
End DoDot:3
QUIT
End DoDot:2
IF ABMTXFLG=1
QUIT
End DoDot:1
+39 KILL DR
+40 QUIT
+41 ;
10 WRITE !
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".89["_ABM("#")_"] Similiar Illness or Injury Date"
DO ^DIE
KILL DR
+1 IF X>ABMP("VDT")
WRITE *7,!!,"ERROR: Date can not be after the Visit Date (",$$HDT^ABMDUTL(ABMP("VDT")),")!"
SET DR=".89///@"
DO ^DIE
GOTO 10
+2 QUIT
+3 ;
4 KILL DIR
WRITE !
SET DIR(0)="Y"
SET DIR("A")="["_ABM("#")_"] Was Visit Employment Related"
SET DIR("?")="Was the Reason for the Visit Related to Employment"
+1 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),9))
IF $PIECE(^(9),U,1)="Y"
SET DIR("B")="Y"
+2 IF '$TEST
SET DIR("B")="N"
+3 DO ^DIR
KILL DIR
+4 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+5 SET ABM("Y")=Y
+6 IF Y=1
GOTO EMCODE
+7 IF ABM("Y")=0
IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),9))
IF $PIECE(^(9),U,1)="Y"
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".91///@;.92///@;.93///@;.94///@;.95///@;.96///@"
DO ^DIE
KILL DR
+8 IF ($DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),53,0))<10)
QUIT
+9 SET DA(1)=ABMP("CDFN")
SET DIK="^ABMDCLM(DUZ(2),"_DA(1)_",53,"
SET DA=$ORDER(^ABMDCODE("AC","C",2,""))
DO ^DIK
+10 QUIT
EMCODE ;
+1 ;S (DINUM,X)=$O(^ABMDCODE("AC","C",2,"")) Q:X="" ;abm*2.6*21 IHS/SD/SDR HEAT159770
+2 ;abm*2.6*21 IHS/SD/SDR HEAT159770
SET (DINUM,X)=$ORDER(^ABMDCODE("AC","C","02",""))
IF X=""
QUIT
+3 KILL DD,DO
SET DA(1)=ABMP("CDFN")
SET DIC="^ABMDCLM(DUZ(2),"_DA(1)_",53,"
SET DIC(0)="LE"
+4 IF '$DATA(^ABMDCLM(DUZ(2),DA(1),53,0))
SET ^ABMDCLM(DUZ(2),DA(1),53,0)="^9002274.3053P^^"
+5 DO FILE^DICN
KILL DIC
+6 SET DR=".91////Y"
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
WRITE !
+7 IF "AB"'[$EXTRACT(ABM("QU"),$LENGTH(ABM("QU")))
GOTO ESET
+8 IF $EXTRACT(ABM("QU"),$LENGTH(ABM("QU")))="B"
SET DR=DR_";.93Unable to Work From Date...: ;I X="""" S Y=""@9"";.94Unable to Work Thru Date...: ;@9"
+9 IF '$TEST
SET DR=DR_";.92T;.93T;I X="""" S Y=.95;.94T;.95T;I X="""" S Y=""@9"";.96T;@9"
ESET DO ^DIE
KILL DR
+1 QUIT
+2 ;
13 ;
+1 QUIT
+2 ;
14 WRITE !
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".48["_ABM("#")_"] Assigned Case Number"
DO ^DIE
KILL DR
+1 QUIT
+2 ;
15 WRITE !
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".49["_ABM("#")_"] Medicaid Resubmission No."
DO ^DIE
KILL DR
+1 QUIT
+2 ;
16 WRITE !
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".43["_ABM("#")_"] Number Radiographs Submitted"
DO ^DIE
KILL DR
+1 QUIT
+2 ;
17 WRITE !
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".44["_ABM("#")_"] Orthodontic Related"
DO ^DIE
KILL DR
+1 IF X'=1
QUIT
+2 SET DR=".45 Placement Date"
DO ^DIE
+3 SET DR="413 Months of Treatment Remaining:"
DO ^DIE
+4 IF X>ABMP("VDT")
WRITE *7,!!,"ERROR: Date can not be after the Visit Date (",$$HDT^ABMDUTL(ABMP("VDT")),")!"
SET DR=".45///@"
DO ^DIE
GOTO 17
+5 QUIT
+6 ;
18 WRITE !
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".46["_ABM("#")_"] Init. Prosthesis Placed"
DO ^DIE
KILL DR
+1 IF X=0
SET DR=".47 Prior Placement Date"
DO ^DIE
+2 QUIT
+3 ;
19 WRITE !
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".58["_ABM("#")_"] Peer Review Organization (PRO) Approval No."
DO ^DIE
KILL DR
+1 QUIT
20 ;HCFA-1500B BLOCK 19
+1 SET $PIECE(ABM("-"),"-",49)=""
WRITE !,?15,ABM("-")
+2 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR="10["_ABM("#")_"] Block 19"
DO ^DIE
KILL DR
+3 QUIT
21 ;TYPE OF ADMISSION
+1 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".51["_ABM("#")_"] Admission Type"
DO ^DIE
+2 QUIT
22 ;SOURCE OF ADMISSION
+1 IF '$DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),5))
SET ^(5)=""
+2 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".52["_ABM("#")_"] Admission Source"
DO ^DIE
+3 QUIT
23 ;DISCHARGE STATUS
+1 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".53["_ABM("#")_"]Discharge Status"
DO ^DIE
+2 QUIT
24 ;Admitting DX
+1 ;abm*2.6*10 ICD10 002E
WRITE !,"** CODING SYSTEM IS "_$SELECT(ABMP("VDT")<ABMP("ICD10"):"ICD-9",1:"ICD-10")_" **"
+2 ;start old abm*2.6*14 ICD10 002E
+3 ;start new abm*2.6*10 ICD10 002E
+4 ;I $D(^ROUTINE("ICDSAPI")) D Q
+5 ;.W !,"["_ABM("#")_"] Admitting DX"
+6 ;.S ABMFLD=+$$SEARCH^ICDSAPI("DIAG",,,$S($G(ABMP("ICD10")):ABMP("ICD10"),$G(ABMP("VDT")):ABMP("VDT"),1:DT))
+7 ;.I ABMFLD>0 S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=ABMFLD D ^DIE
+8 ;end new code ICD10 002E
+9 ;S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".59["_ABM("#")_"] Admitting DX" D ^DIE
+10 ;end old start new ICD10 002E
+11 KILL DIR,DR,X,Y
+12 SET DIR(0)="PO^80:QEAM"
+13 IF ABMP("VDT")<ABMP("ICD10")
SET DIR("S")="I $P($$DX^ABMCVAPI(+Y),U,20)'=30"
+14 IF '(ABMP("VDT")<ABMP("ICD10"))
SET DIR("S")="I $P($$DX^ABMCVAPI(+Y),U,20)=30"
+15 SET DIR("A")="["_ABM("#")_"] Admitting DX"
+16 ;abm*2.6*14 HEAT163740
IF (+$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U,9))
SET DIR("B")=$PIECE($$DX^ABMCVAPI(+$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U,9)),U,2)
+17 DO ^DIR
+18 IF X="@"
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".59////@"
DO ^DIE
+19 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+20 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".59////"_+Y
DO ^DIE
+21 ;end new ICD10 002E
+22 QUIT
25 ; Supervising Prov (FL19)
+1 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".912["_ABM("#")_"] Supervising Prov.(FL19)"
DO ^DIE
+2 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".911["_ABM("#")_"] Date Last Seen"
DO ^DIE
+3 SET ABMNPIU=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
+4 IF ABMNPIU="B"!(ABMNPIU="N")
Begin DoDot:1
+5 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR="925["_ABM("#")_"] NPI"
DO ^DIE
End DoDot:1
+6 IF ABMNPIU'="N"
Begin DoDot:1
+7 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR="924["_ABM("#")_"] I.D. Number (UPIN)"
DO ^DIE
End DoDot:1
+8 QUIT
26 ; Date of Last X-Ray
+1 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".913["_ABM("#")_"] Date of Last X-Ray"
DO ^DIE
+2 QUIT
27 ;Referral Number
+1 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".511["_ABM("#")_"] Referral Number"
DO ^DIE
+2 QUIT
28 ;Prior Authorization Number
+1 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".512["_ABM("#")_"] Prior Authorizaion Number"
DO ^DIE
+2 QUIT
29 ;Homebound Indicator
+1 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".914["_ABM("#")_"] Homebound Indicator"
DO ^DIE
+2 QUIT
30 ;Hospice Employed Provider
+1 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".915["_ABM("#")_"] Hospice Employed Provider"
DO ^DIE
+2 QUIT
31 ;Delayed Reason Code
+1 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".916["_ABM("#")_"] Delayed Reason Code"
DO ^DIE
+2 QUIT
32 ;#Enclosures - Radiographs/Oral Images/Models
+1 WRITE !,"Number of Enclosures: ",!
+2 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".917 Radiographs"
DO ^DIE
+3 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".918 Oral Images"
DO ^DIE
+4 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".919 Models"
DO ^DIE
+5 QUIT
33 ;Other Dental Charges
+1 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".921["_ABM("#")_"] Other Dental Charges"
DO ^DIE
+2 QUIT
34 ;Reference Lab CLIA#
+1 NEW ABMDCLIA
+2 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
+3 SET ABMDCLIA=$PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,12)
+4 IF ABMDCLIA'=""
SET ABMDCLIA=$PIECE($GET(^ABMRLABS(ABMDCLIA,0)),U)
+5 IF ABMDCLIA'=""
SET ABMDCLIA=$PIECE($GET(^AUTTVNDR(ABMDCLIA,0)),U)
+6 SET DR=".923"_$SELECT(ABMDCLIA'="":"//"_ABMDCLIA,1:"")
+7 DO ^DIE
+8 KILL ABMDCLIA
+9 QUIT
35 ;In-House CLIA#
+1 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".922["_ABM("#")_"] In-House CLIA#: //"_$PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,11)
DO ^DIE
+2 QUIT
+3 ;start new abm*2.6*6 5010
36 ;Hearing and Vision Prescription Date
+1 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".714["_ABM("#")_"] Hearing/Vision Prescription Date: //"
DO ^DIE
+2 QUIT
37 ;Start/End Disability Dates
+1 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
+2 SET DR=".715["_ABM("#")_"] Start Disability Date: //"
DO ^DIE
+3 SET DR=".716["_ABM("#")_"] End Disability Date: //"
DO ^DIE
+4 QUIT
38 ;Assumed/Relinquished Care Dates
+1 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
+2 SET DR=".719["_ABM("#")_"] Assumed Care Date: //"
DO ^DIE
+3 SET DR=".721["_ABM("#")_"] Relinquished Care Date: //"
DO ^DIE
+4 QUIT
39 ;Property/Casualty Date of 1st contact
+1 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".722["_ABM("#")_"] Property/Casualty Date of 1st Contact: //"
DO ^DIE
+2 QUIT
40 ;Patient Paid Amount
+1 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".723["_ABM("#")_"] Patient Paid Amount: //"
DO ^DIE
+2 QUIT
41 ;Spinal Manipulation Cond Code
+1 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".724["_ABM("#")_"] Spinal Manipulation Cond Code Ind: //"
DO ^DIE
+2 ;start new abm*2.6*13 exp mode 35
+3 IF "^A^M^"[("^"_$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,24)_"^")
SET DR=".727 Acute Manifestation Date: //"
DO ^DIE
+4 IF "^A^M^"'[("^"_$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,24)_"^")
SET DR=".727////@"
DO ^DIE
+5 ;end new exp mode 35
+6 QUIT
42 ; Vision Condition Info
+1 SET DIE="^ABMDCLM(DUZ(2),"
+2 SET DA=ABMP("CDFN")
+3 SET DR=".821["_ABM("#")_"] Vision Condition Info: //"
+4 SET DR=DR_";W !?3;.822 Vision Certification Condition Indicator: //"
+5 DO ^DIE
+6 FOR
Begin DoDot:1
+7 KILL DIC,DIE,DIR,X,Y,DA
+8 SET DA(1)=ABMP("CDFN")
+9 SET DIC="^ABMDCLM(DUZ(2),"_DA(1)_",8.5,"
+10 SET DIC(0)="AQELM"
+11 SET DIC("P")=$PIECE(^DD(9002274.3,8.5,0),U,2)
+12 DO ^DIC
End DoDot:1
IF Y<0
QUIT
+13 QUIT
+14 ;end new 5010
+15 ;start new abm*2.6*13 exp mode 35
43 ;Initial Treatment Date
+1 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".823["_ABM("#")_"] Initial Treatment Date: //"
DO ^DIE
+2 QUIT
44 ;Ord/Ref/Sup Phys (FL17)
+1 SET ABM("PROVIDER")=$$PRVLKUP^ABMDFUTL($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,24),$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,26))
+2 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".824////"_$SELECT($PIECE(ABM("PROVIDER"),U)'="":$PIECE(ABM("PROVIDER"),U),1:"@")
DO ^DIE
+3 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".826////"_$SELECT($PIECE(ABM("PROVIDER"),U,2)'="":$PIECE(ABM("PROVIDER"),U,2),1:"@")
DO ^DIE
+4 ;abm*2.6*14 HEAT163737
IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,24)=""
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".825////@"
DO ^DIE
+5 ;abm*2.6*14 HEAT163697
IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,26)=""
QUIT
+6 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,24)'=""
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DIE("NO^")=1
SET DR=".825R~Physician Type: //"
DO ^DIE
+7 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,24)=""
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".825////@"
DO ^DIE
+8 QUIT
+9 ;end new exp mode 35
