Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMDE3C

ABMDE3C.m

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