APCDKLV ; IHS/CMI/LAB - LINK DIF DAY LAB VISITS ;
;;2.0;IHS PCC SUITE;**2,11**;MAY 14, 2009;Build 58
;
; -- ** THANKS TO LINDA FELS, ANMC COMPUTER DEPARTMENT
; ** FOR THIS ROUTINE.
; -- This routine takes visits with only v lab entries and completes
; them with a pov of lab draw and lab tech as the provider.
; Using the order date, the original visit is searched for.
; If found, the original visit is set in the Billing Link field
; of the Visit file for the lab only visit.
;
Q
;
QUEUE ;EP; entry point to run linker in background
I '$D(ZTQUEUED) W !!,"Orphaned Lab Linker is being queued to run in the background!",!,"Dates of the run will be automatically calculated based on the PCC delay",!,"value.",!
NEW DELAY,X1,X2,X
Q:'$$LABTECH Q:'$$LABCLN
S DELAY=$$VALI^XBDIQ1(9001005.1,1,.03),DELAY=DELAY+7
S X1=DT,X2=-DELAY D C^%DTC S APCDED=X
S X1=APCDED,X2=-60 D C^%DTC S APCDBD=X
NEW X
S X=$P(^AUTTSITE(1,0),U,24)
Q:X="" ;visit re-linker has not been run - send mail message?
I X<APCDED Q ;visit re-linker not run up to ending date
D START(1)
Q
;
;
MANUAL ;EP; entry to run linker manually
NEW DIR,X,Y,DELAY,X1,X2
D ^XBCLS W !!?20,"FIX UNLINKED LAB VISITS",!!
;
I '$$LABTECH D Q
. W !!,$C(7),"You do not have a generic Lab Technician provider entry"
. W !,"in your database. Cannot run fix for unlinked labs."
. S DIR(0)="E",DIR("A")="Press ENTER" D ^DIR
;
I '$$LABCLN D Q
. W !!,$C(7),"You do not have LABORATORY as a clinic stop. Cannot run"
. W !,"fix for unlinked labs."
. S DIR(0)="E",DIR("A")="Press ENTER" D ^DIR
;
DATES K APCDED,APCDBD
K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Date for Search"
D ^DIR Q:Y<1 S APCDBD=Y
K DIR S DIR(0)="DO^::EXP",DIR("A")="Enter Ending Date for Search"
D ^DIR Q:Y<1 S APCDED=Y
;
I APCDED<APCDBD D G DATES
. W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
;
S DELAY=$$VALI^XBDIQ1(9001005.1,1,.03)
S X1=DT,X2=-DELAY D C^%DTC I APCDED>X D G DATES
. W !!,$C(7),"Sorry, Cannot pick date within PCC Delay. Select a date"
. W !,"earlier than ",$$FMTE^XLFDT(X,5),"."
;
S DELAY=$P(^AUTTSITE(1,0),U,24)
I DELAY="" D G DATES
.W !!,$C(7),"PCC Visit Relinker has not been run. You cannot complete lab visits"
.W !,"until the re-linker is run. See your site manager for assistance."
I DELAY<APCDED D G DATES
.W !!,$C(7),"You have picked a date that is later than the date the visit re-linker",!,"was last run. You must run the visit re-linker first. See your site manager",!,"for assistance."
.W " You must pick an ending date which is earlier than ",$$FMTE^XLFDT(DELAY,5),".",!
K DIR S DIR(0)="Y"
S DIR("A")="Do you want these visits transmitted to the Data Center"
S DIR("?",1)="Answer YES if the data range you have selected is for"
S DIR("?",2)="the current fiscal year. You WILL want those visits"
S DIR("?",3)="transmitted to DDPS.",DIR("?",4)=" "
S DIR("?",5)="Answer NO if you are running this for past fiscal years."
S DIR("?")=" " D ^DIR Q:Y=U
;
W !!,"Search begun"
D START(Y)
W !!,"Search COMPLETED. ",+$G(APCDCNT)," Visits fixed."
Q
;
;
START(APCDZMOD) ; begin of linker logic
; APCDZMOD=1 if MOD^AUPNVSIT is to be called
NEW APCDT,APCDEND,APCDV,X,Y
Q:'$G(APCDBD) Q:'$G(APCDED)
;
; -- loop visit dates to find unlinked labs
S APCDCNT=0,APCDT=APCDBD-.0001,APCDEND=APCDED+.2400
F S APCDT=$O(^AUPNVSIT("B",APCDT)) Q:'APCDT!(APCDT>APCDEND) D
. S APCDV=0
. F S APCDV=$O(^AUPNVSIT("B",APCDT,APCDV)) Q:'APCDV D
.. I $D(^AUPNVPOV("AD",APCDV))!$D(^AUPNVPRV("AD",APCDV)) Q ;good vst
.. Q:'$D(^AUPNVLAB("AD",APCDV)) ;not a lab visit
.. S X=$$VALI^XBDIQ1(9000010,APCDV,.07) I (X'="A"),(X'="S") Q
.. ;S X=$O(^AUPNVLAB("AD",APCDV,0)) I X,$$GET1^DIQ(9000010.09,X,1202)\1=APCDT\1 Q ;if ordered on same date, quit
.. S X=$O(^AUPNVLAB("AD",APCDV,0)) I X,($P($P($G(^AUPNVLAB(X,12)),U,11),".")=$P(APCDT,".")) Q
.. ;
.. D LINK(APCDV) ;link to original visit
.. D STUFF(APCDV,APCDZMOD) ;stuff pov and provider
.. I '$D(ZTQUEUED) S APCDCNT=$G(APCDCNT)+1 W "."
.. I $P($G(^APCDSITE(DUZ(2),0)),U,24)="Y" D
... K DD,D0,DO,DINUM,DIC,DA,DR S DIC(0)="EL",DIC="^APCDLLOG(",DLAYGO=9001001.7,DIADD=1,X=APCDV,DIC("DR")=".02////"_DT_";.03///L" D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0
.. ;W !,APCDT,?20,APCDV Q ;used to watch progress of rtn
K APCDED,APCDBD,APCDCNT
Q
;
;
LINK(APCDVST) ; -- find orig visit and set link
NEW APCDX,APCDLAB,ORDT,ORDPRV,DFN,DATE,PRV,ORDV,LINK
;
; -- get first lab entry for visit
S APCDLAB=$O(^AUPNVLAB("AD",APCDVST,0)) Q:'APCDLAB
K APCDX D ENP^XBDIQ1(9000010.09,APCDLAB,".02;1202;1211","APCDX(","I")
S ORDT=APCDX(1211,"I") Q:ORDT="" ;order date
S ORDPRV=APCDX(1202,"I") Q:ORDPRV="" ;ordering provider
S DFN=APCDX(.02,"I") Q:DFN="" ;patient
;
; -- look for orig visit based on order date for patient and provider
K LINK S DATE=$$RVDT(ORDT)-.0001,END=$$RVDT(ORDT)+.9999999
F S DATE=$O(^AUPNVSIT("AA",DFN,DATE)) Q:'DATE!(DATE>END)!($D(LINK)) D
. ; -- find all visits for patient on order date
. S ORDV=0 F S ORDV=$O(^AUPNVSIT("AA",DFN,DATE,ORDV)) Q:'ORDV D
.. ; -- find if ordering provider linked to this visit
.. S PRV=0 F S PRV=$O(^AUPNVPRV("AD",ORDV,PRV)) Q:'PRV!($D(LINK)) D
... I +^AUPNVPRV(PRV,0)=ORDPRV S LINK=ORDV ;orig visit found
;
; -- if orig visit found, set link
I $G(LINK) S DIE=9000010,DA=APCDVST,DR=".28////"_LINK D ^DIE
Q
;
;
STUFF(AUPNVSIT,APCDZMOD) ; -- stuff pov and provider
NEW APCDT,APCDV ;protect variables from loop
NEW APCDALVR,DFN
S DFN=$$VALI^XBDIQ1(9000010,AUPNVSIT,.05) Q:DFN=""
;
; -- if okay to transmit, set date modified
I APCDZMOD D MOD^AUPNVSIT
;
; -- stuff lab as clinic if clinic is blank
I $$VALI^XBDIQ1(9000010,AUPNVSIT,.08)="" D
. S DIE="^AUPNVSIT(",DA=AUPNVSIT,DR=".08////"_$$LABCLN D ^DIE
;
; -- create purpose of visit entry
; -- uses lab draw (ICD code V72.69)
K APCDALVR
S APCDALVR("APCDPAT")=DFN,APCDALVR("APCDVSIT")=AUPNVSIT
S APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
S APCDALVR("APCDTPOV")=$$CODE($$VD^APCLV(AUPNVSIT)) ;"V72.69"
S APCDALVR("APCDTNQ")="LABORATORY EXAMINATION"
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) Q
;
; -- create v provider entry
; -- uses lab tech (23) plus affiliation based on PCC site type
K APCDALVR
S APCDALVR("APCDPAT")=DFN,APCDALVR("APCDVSIT")=AUPNVSIT
S APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
I $$PROVP=6 S X=$O(^DIC(6,"GIHS",$$LABTECH,0)) Q:'X
I $$PROVP=200 S X=$O(^VA(200,"GIHS",$$LABTECH,0)) Q:'X
S APCDALVR("APCDTPRO")="`"_X
S APCDALVR("APCDTPS")="P"
D ^APCDALVR
;stuff 1111 field of visit with reviewed status
S DA=AUPNVSIT,DIE="^AUPNVSIT(",DR="1111///R" D ^DIE K DIE,DA,DR
Q
CODE(D) ;EP
NEW C
S C=$$IMP^AUPNSICD(D)
I C=30 Q "Z01.89"
Q "V72.69"
;
RVDT(X) ; -- returns reverse date
Q 9999999-X
;
LABTECH() ; -- returns code if lab tech entry exists in file 200
NEW SITE,CODE
S SITE=$$VALI^XBDIQ1(9001000,DUZ(2),.04) I SITE="" Q 0
S CODE=$P($T(@SITE),";;",2)_"23999"
I $$PROVP=200,'$D(^VA(200,"GIHS",CODE)) Q 0
I $$PROVP=6,'$D(^DIC(6,"GIHS",CODE)) Q 0
Q CODE
;
PROVP() ; -- returns pointer file # for providers
NEW X S X=$P(^DD(9000010.06,.01,0),U,2)
Q $S(X["200":200,1:6)
;
LABCLN() ; -- returns ien for lab clinic code
Q +$O(^DIC(40.7,"C","76",0))
;
AFFIL ;; affiliation recode
I ;;1;;IHS
C ;;2;;CONTRACT
T ;;3;;TRIBAL
O ;;9;;OTHER
6 ;;8;;638
V ;;9;;VA (OTHER)
P ;;3;;TRIBAL
U ;;9;;OTHER
APCDKLV ; IHS/CMI/LAB - LINK DIF DAY LAB VISITS ;
+1 ;;2.0;IHS PCC SUITE;**2,11**;MAY 14, 2009;Build 58
+2 ;
+3 ; -- ** THANKS TO LINDA FELS, ANMC COMPUTER DEPARTMENT
+4 ; ** FOR THIS ROUTINE.
+5 ; -- This routine takes visits with only v lab entries and completes
+6 ; them with a pov of lab draw and lab tech as the provider.
+7 ; Using the order date, the original visit is searched for.
+8 ; If found, the original visit is set in the Billing Link field
+9 ; of the Visit file for the lab only visit.
+10 ;
+11 QUIT
+12 ;
QUEUE ;EP; entry point to run linker in background
+1 IF '$DATA(ZTQUEUED)
WRITE !!,"Orphaned Lab Linker is being queued to run in the background!",!,"Dates of the run will be automatically calculated based on the PCC delay",!,"value.",!
+2 NEW DELAY,X1,X2,X
+3 IF '$$LABTECH
QUIT
IF '$$LABCLN
QUIT
+4 SET DELAY=$$VALI^XBDIQ1(9001005.1,1,.03)
SET DELAY=DELAY+7
+5 SET X1=DT
SET X2=-DELAY
DO C^%DTC
SET APCDED=X
+6 SET X1=APCDED
SET X2=-60
DO C^%DTC
SET APCDBD=X
+7 NEW X
+8 SET X=$PIECE(^AUTTSITE(1,0),U,24)
+9 ;visit re-linker has not been run - send mail message?
IF X=""
QUIT
+10 ;visit re-linker not run up to ending date
IF X<APCDED
QUIT
+11 DO START(1)
+12 QUIT
+13 ;
+14 ;
MANUAL ;EP; entry to run linker manually
+1 NEW DIR,X,Y,DELAY,X1,X2
+2 DO ^XBCLS
WRITE !!?20,"FIX UNLINKED LAB VISITS",!!
+3 ;
+4 IF '$$LABTECH
Begin DoDot:1
+5 WRITE !!,$CHAR(7),"You do not have a generic Lab Technician provider entry"
+6 WRITE !,"in your database. Cannot run fix for unlinked labs."
+7 SET DIR(0)="E"
SET DIR("A")="Press ENTER"
DO ^DIR
End DoDot:1
QUIT
+8 ;
+9 IF '$$LABCLN
Begin DoDot:1
+10 WRITE !!,$CHAR(7),"You do not have LABORATORY as a clinic stop. Cannot run"
+11 WRITE !,"fix for unlinked labs."
+12 SET DIR(0)="E"
SET DIR("A")="Press ENTER"
DO ^DIR
End DoDot:1
QUIT
+13 ;
DATES KILL APCDED,APCDBD
+1 KILL DIR
WRITE !
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Beginning Date for Search"
+2 DO ^DIR
IF Y<1
QUIT
SET APCDBD=Y
+3 KILL DIR
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Ending Date for Search"
+4 DO ^DIR
IF Y<1
QUIT
SET APCDED=Y
+5 ;
+6 IF APCDED<APCDBD
Begin DoDot:1
+7 WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
End DoDot:1
GOTO DATES
+8 ;
+9 SET DELAY=$$VALI^XBDIQ1(9001005.1,1,.03)
+10 SET X1=DT
SET X2=-DELAY
DO C^%DTC
IF APCDED>X
Begin DoDot:1
+11 WRITE !!,$CHAR(7),"Sorry, Cannot pick date within PCC Delay. Select a date"
+12 WRITE !,"earlier than ",$$FMTE^XLFDT(X,5),"."
End DoDot:1
GOTO DATES
+13 ;
+14 SET DELAY=$PIECE(^AUTTSITE(1,0),U,24)
+15 IF DELAY=""
Begin DoDot:1
+16 WRITE !!,$CHAR(7),"PCC Visit Relinker has not been run. You cannot complete lab visits"
+17 WRITE !,"until the re-linker is run. See your site manager for assistance."
End DoDot:1
GOTO DATES
+18 IF DELAY<APCDED
Begin DoDot:1
+19 WRITE !!,$CHAR(7),"You have picked a date that is later than the date the visit re-linker",!,"was last run. You must run the visit re-linker first. See your site manager",!,"for assistance."
+20 WRITE " You must pick an ending date which is earlier than ",$$FMTE^XLFDT(DELAY,5),".",!
End DoDot:1
GOTO DATES
+21 KILL DIR
SET DIR(0)="Y"
+22 SET DIR("A")="Do you want these visits transmitted to the Data Center"
+23 SET DIR("?",1)="Answer YES if the data range you have selected is for"
+24 SET DIR("?",2)="the current fiscal year. You WILL want those visits"
+25 SET DIR("?",3)="transmitted to DDPS."
SET DIR("?",4)=" "
+26 SET DIR("?",5)="Answer NO if you are running this for past fiscal years."
+27 SET DIR("?")=" "
DO ^DIR
IF Y=U
QUIT
+28 ;
+29 WRITE !!,"Search begun"
+30 DO START(Y)
+31 WRITE !!,"Search COMPLETED. ",+$GET(APCDCNT)," Visits fixed."
+32 QUIT
+33 ;
+34 ;
START(APCDZMOD) ; begin of linker logic
+1 ; APCDZMOD=1 if MOD^AUPNVSIT is to be called
+2 NEW APCDT,APCDEND,APCDV,X,Y
+3 IF '$GET(APCDBD)
QUIT
IF '$GET(APCDED)
QUIT
+4 ;
+5 ; -- loop visit dates to find unlinked labs
+6 SET APCDCNT=0
SET APCDT=APCDBD-.0001
SET APCDEND=APCDED+.2400
+7 FOR
SET APCDT=$ORDER(^AUPNVSIT("B",APCDT))
IF 'APCDT!(APCDT>APCDEND)
QUIT
Begin DoDot:1
+8 SET APCDV=0
+9 FOR
SET APCDV=$ORDER(^AUPNVSIT("B",APCDT,APCDV))
IF 'APCDV
QUIT
Begin DoDot:2
+10 ;good vst
IF $DATA(^AUPNVPOV("AD",APCDV))!$DATA(^AUPNVPRV("AD",APCDV))
QUIT
+11 ;not a lab visit
IF '$DATA(^AUPNVLAB("AD",APCDV))
QUIT
+12 SET X=$$VALI^XBDIQ1(9000010,APCDV,.07)
IF (X'="A")
IF (X'="S")
QUIT
+13 ;S X=$O(^AUPNVLAB("AD",APCDV,0)) I X,$$GET1^DIQ(9000010.09,X,1202)\1=APCDT\1 Q ;if ordered on same date, quit
+14 SET X=$ORDER(^AUPNVLAB("AD",APCDV,0))
IF X
IF ($PIECE($PIECE($GET(^AUPNVLAB(X,12)),U,11),".")=$PIECE(APCDT,"."))
QUIT
+15 ;
+16 ;link to original visit
DO LINK(APCDV)
+17 ;stuff pov and provider
DO STUFF(APCDV,APCDZMOD)
+18 IF '$DATA(ZTQUEUED)
SET APCDCNT=$GET(APCDCNT)+1
WRITE "."
+19 IF $PIECE($GET(^APCDSITE(DUZ(2),0)),U,24)="Y"
Begin DoDot:3
+20 KILL DD,D0,DO,DINUM,DIC,DA,DR
SET DIC(0)="EL"
SET DIC="^APCDLLOG("
SET DLAYGO=9001001.7
SET DIADD=1
SET X=APCDV
SET DIC("DR")=".02////"_DT_";.03///L"
DO FILE^DICN
KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0
End DoDot:3
+21 ;W !,APCDT,?20,APCDV Q ;used to watch progress of rtn
End DoDot:2
End DoDot:1
+22 KILL APCDED,APCDBD,APCDCNT
+23 QUIT
+24 ;
+25 ;
LINK(APCDVST) ; -- find orig visit and set link
+1 NEW APCDX,APCDLAB,ORDT,ORDPRV,DFN,DATE,PRV,ORDV,LINK
+2 ;
+3 ; -- get first lab entry for visit
+4 SET APCDLAB=$ORDER(^AUPNVLAB("AD",APCDVST,0))
IF 'APCDLAB
QUIT
+5 KILL APCDX
DO ENP^XBDIQ1(9000010.09,APCDLAB,".02;1202;1211","APCDX(","I")
+6 ;order date
SET ORDT=APCDX(1211,"I")
IF ORDT=""
QUIT
+7 ;ordering provider
SET ORDPRV=APCDX(1202,"I")
IF ORDPRV=""
QUIT
+8 ;patient
SET DFN=APCDX(.02,"I")
IF DFN=""
QUIT
+9 ;
+10 ; -- look for orig visit based on order date for patient and provider
+11 KILL LINK
SET DATE=$$RVDT(ORDT)-.0001
SET END=$$RVDT(ORDT)+.9999999
+12 FOR
SET DATE=$ORDER(^AUPNVSIT("AA",DFN,DATE))
IF 'DATE!(DATE>END)!($DATA(LINK))
QUIT
Begin DoDot:1
+13 ; -- find all visits for patient on order date
+14 SET ORDV=0
FOR
SET ORDV=$ORDER(^AUPNVSIT("AA",DFN,DATE,ORDV))
IF 'ORDV
QUIT
Begin DoDot:2
+15 ; -- find if ordering provider linked to this visit
+16 SET PRV=0
FOR
SET PRV=$ORDER(^AUPNVPRV("AD",ORDV,PRV))
IF 'PRV!($DATA(LINK))
QUIT
Begin DoDot:3
+17 ;orig visit found
IF +^AUPNVPRV(PRV,0)=ORDPRV
SET LINK=ORDV
End DoDot:3
End DoDot:2
End DoDot:1
+18 ;
+19 ; -- if orig visit found, set link
+20 IF $GET(LINK)
SET DIE=9000010
SET DA=APCDVST
SET DR=".28////"_LINK
DO ^DIE
+21 QUIT
+22 ;
+23 ;
STUFF(AUPNVSIT,APCDZMOD) ; -- stuff pov and provider
+1 ;protect variables from loop
NEW APCDT,APCDV
+2 NEW APCDALVR,DFN
+3 SET DFN=$$VALI^XBDIQ1(9000010,AUPNVSIT,.05)
IF DFN=""
QUIT
+4 ;
+5 ; -- if okay to transmit, set date modified
+6 IF APCDZMOD
DO MOD^AUPNVSIT
+7 ;
+8 ; -- stuff lab as clinic if clinic is blank
+9 IF $$VALI^XBDIQ1(9000010,AUPNVSIT,.08)=""
Begin DoDot:1
+10 SET DIE="^AUPNVSIT("
SET DA=AUPNVSIT
SET DR=".08////"_$$LABCLN
DO ^DIE
End DoDot:1
+11 ;
+12 ; -- create purpose of visit entry
+13 ; -- uses lab draw (ICD code V72.69)
+14 KILL APCDALVR
+15 SET APCDALVR("APCDPAT")=DFN
SET APCDALVR("APCDVSIT")=AUPNVSIT
+16 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
+17 ;"V72.69"
SET APCDALVR("APCDTPOV")=$$CODE($$VD^APCLV(AUPNVSIT))
+18 SET APCDALVR("APCDTNQ")="LABORATORY EXAMINATION"
+19 DO ^APCDALVR
+20 IF $DATA(APCDALVR("APCDAFLG"))
QUIT
+21 ;
+22 ; -- create v provider entry
+23 ; -- uses lab tech (23) plus affiliation based on PCC site type
+24 KILL APCDALVR
+25 SET APCDALVR("APCDPAT")=DFN
SET APCDALVR("APCDVSIT")=AUPNVSIT
+26 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
+27 IF $$PROVP=6
SET X=$ORDER(^DIC(6,"GIHS",$$LABTECH,0))
IF 'X
QUIT
+28 IF $$PROVP=200
SET X=$ORDER(^VA(200,"GIHS",$$LABTECH,0))
IF 'X
QUIT
+29 SET APCDALVR("APCDTPRO")="`"_X
+30 SET APCDALVR("APCDTPS")="P"
+31 DO ^APCDALVR
+32 ;stuff 1111 field of visit with reviewed status
+33 SET DA=AUPNVSIT
SET DIE="^AUPNVSIT("
SET DR="1111///R"
DO ^DIE
KILL DIE,DA,DR
+34 QUIT
CODE(D) ;EP
+1 NEW C
+2 SET C=$$IMP^AUPNSICD(D)
+3 IF C=30
QUIT "Z01.89"
+4 QUIT "V72.69"
+5 ;
RVDT(X) ; -- returns reverse date
+1 QUIT 9999999-X
+2 ;
LABTECH() ; -- returns code if lab tech entry exists in file 200
+1 NEW SITE,CODE
+2 SET SITE=$$VALI^XBDIQ1(9001000,DUZ(2),.04)
IF SITE=""
QUIT 0
+3 SET CODE=$PIECE($TEXT(@SITE),";;",2)_"23999"
+4 IF $$PROVP=200
IF '$DATA(^VA(200,"GIHS",CODE))
QUIT 0
+5 IF $$PROVP=6
IF '$DATA(^DIC(6,"GIHS",CODE))
QUIT 0
+6 QUIT CODE
+7 ;
PROVP() ; -- returns pointer file # for providers
+1 NEW X
SET X=$PIECE(^DD(9000010.06,.01,0),U,2)
+2 QUIT $SELECT(X["200":200,1:6)
+3 ;
LABCLN() ; -- returns ien for lab clinic code
+1 QUIT +$ORDER(^DIC(40.7,"C","76",0))
+2 ;
AFFIL ;; affiliation recode
I ;;1;;IHS
C ;;2;;CONTRACT
T ;;3;;TRIBAL
O ;;9;;OTHER
6 ;;8;;638
V ;;9;;VA (OTHER)
P ;;3;;TRIBAL
U ;;9;;OTHER
