APCDKIV ; IHS/CMI/LAB - LINK DIF DAY IMMUNIZATION VISITS ;
;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
;
; -- ** THANKS TO LINDA FELS, ANMC COMPUTER DEPARTMENT
; ** FOR THIS ROUTINE.
; -- This routine takes visits with only v imm entries and completes
; them with a pov of rx refill and pharmacist 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 rad only visit.
;
Q
;
QUEUE ;EP; entry point to run linker in background
I '$D(ZTQUEUED) W !!,"Orphaned Immunization 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:'$$IMMCLN
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 IMMUNIZATION VISITS",!!
;
I '$$IMMCLN D Q
. W !!,$C(7),"You do not have IMMUNIZATION as a clinic stop. Cannot run"
. W !,"fix for unlinked immunization visits."
. S DIR(0)="E",DIR("A")="Press ENTER" D ^DIR
;
DATES K APCDED,APCDBD
W !,"When choosing a date rante for visits keep in mind that you should run this",!,"utility for visit dates that have not been completed by data entry.",!!
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 rad 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 imms
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(^AUPNVIMM("AD",APCDV)) ;not a imm visit
.. S X=$$VALI^XBDIQ1(9000010,APCDV,.07) I (X'="A"),(X'="S") Q ;only ambulatory
.. ;S X=$O(^AUPNVIMM("AD",APCDV,0)) I X,$$GET1^DIQ(9000010.09,X,1204)\1=APCDT\1 Q ;if ordered on same date, quit
.. ;S X=$O(^AUPNVIMM("AD",APCDV,0)) I X,($P($P($G(^AUPNVIMM(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///I" 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,APCDIMM,ORDT,ORDPRV,DFN,DATE,PRV,ORDV,LINK
;
; -- get first rx entry for visit
S APCDIMM=$O(^AUPNVIMM("AD",APCDVST,0)) Q:'APCDIMM
K APCDX D ENP^XBDIQ1(9000010.11,APCDIMM,".02;1204;1211","APCDX(","I")
S ORDT=APCDX(1211,"I") Q:ORDT="" ;order date
S ORDPRV=APCDX(1204,"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 imm as clinic if clinic is blank
I $$VALI^XBDIQ1(9000010,AUPNVSIT,.08)="" D
. S DIE="^AUPNVSIT(",DA=AUPNVSIT,DR=".08////"_$$IMMCLN D ^DIE
;
; -- create purpose of visit entry
; -- uses imm code from V immumization entries
S APCDIMM=0 F S APCDIMM=$O(^AUPNVIMM("AD",AUPNVSIT,APCDIMM)) Q:APCDIMM'=+APCDIMM D
.K APCDALVR
.S APCDALVR("APCDPAT")=DFN,APCDALVR("APCDVSIT")=AUPNVSIT
.S APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
.S APCDI=$P(^AUPNVIMM(APCDIMM,0),U),I=$P(^AUTTIMM(APCDI,0),U,14)
.S APCDALVR("APCDTPOV")=$$CODE($$VD^APCLV(AUPNVSIT))
.S APCDALVR("APCDTNQ")=$P(^AUTTIMM(APCDI,0),U)_" ***IMMUNIZATION***"
.D ^APCDALVR
;
; -- create v provider entry
; -- uses immprov (1204 field value)
K APCDIMPR
S APCDIMM=0 F S APCDIMM=$O(^AUPNVIMM("AD",AUPNVSIT,APCDIMM)) Q:APCDIMM'=+APCDIMM D
.K APCDALVR
.S APCDALVR("APCDPAT")=DFN,APCDALVR("APCDVSIT")=AUPNVSIT
.S APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
.S APCDX=$P($G(^AUPNVIMM(APCDIMM,12)),U,4)
.Q:'APCDX
.I $$PROVP=6 S APCDX=$P(^VA(200,APCDX,0),U,16)
.Q:$D(APCDIMPR(APCDX)) ;already have this provider
.S APCDALVR("APCDTPRO")="`"_APCDX
.S APCDALVR("APCDTPS")=$S($D(APCDIMPR):"S",1:"P")
.D ^APCDALVR
.I '$D(APCDALVR("APCDAFLG")) S APCDIMPR(APCDX)=""
;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) ;
NEW C
S C=$$IMP^AUPNSICD(D)
I C=30 Q "Z41.8"
Q "V07.9"
;
RVDT(X) ; -- returns reverse date
Q 9999999-X
;
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)
;
IMMCLN() ; -- returns ien for imm clinic code
Q +$O(^DIC(40.7,"C","12",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
APCDKIV ; IHS/CMI/LAB - LINK DIF DAY IMMUNIZATION VISITS ;
+1 ;;2.0;IHS PCC SUITE;**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 imm entries and completes
+6 ; them with a pov of rx refill and pharmacist 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 rad only visit.
+10 ;
+11 QUIT
+12 ;
QUEUE ;EP; entry point to run linker in background
+1 IF '$DATA(ZTQUEUED)
WRITE !!,"Orphaned Immunization 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 '$$IMMCLN
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 IMMUNIZATION VISITS",!!
+3 ;
+4 IF '$$IMMCLN
Begin DoDot:1
+5 WRITE !!,$CHAR(7),"You do not have IMMUNIZATION as a clinic stop. Cannot run"
+6 WRITE !,"fix for unlinked immunization visits."
+7 SET DIR(0)="E"
SET DIR("A")="Press ENTER"
DO ^DIR
End DoDot:1
QUIT
+8 ;
DATES KILL APCDED,APCDBD
+1 WRITE !,"When choosing a date rante for visits keep in mind that you should run this",!,"utility for visit dates that have not been completed by data entry.",!!
+2 KILL DIR
WRITE !
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Beginning Date for Search"
+3 DO ^DIR
IF Y<1
QUIT
SET APCDBD=Y
+4 KILL DIR
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Ending Date for Search"
+5 DO ^DIR
IF Y<1
QUIT
SET APCDED=Y
+6 ;
+7 IF APCDED<APCDBD
Begin DoDot:1
+8 WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
End DoDot:1
GOTO DATES
+9 ;
+10 SET DELAY=$$VALI^XBDIQ1(9001005.1,1,.03)
+11 SET X1=DT
SET X2=-DELAY
DO C^%DTC
IF APCDED>X
Begin DoDot:1
+12 WRITE !!,$CHAR(7),"Sorry, Cannot pick date within PCC Delay. Select a date"
+13 WRITE !,"earlier than ",$$FMTE^XLFDT(X,5),"."
End DoDot:1
GOTO DATES
+14 ;
+15 SET DELAY=$PIECE(^AUTTSITE(1,0),U,24)
+16 IF DELAY=""
Begin DoDot:1
+17 WRITE !!,$CHAR(7),"PCC Visit Relinker has not been run. You cannot complete rad visits"
+18 WRITE !,"until the re-linker is run. See your site manager for assistance."
End DoDot:1
GOTO DATES
+19 IF DELAY<APCDED
Begin DoDot:1
+20 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."
+21 WRITE " You must pick an ending date which is earlier than ",$$FMTE^XLFDT(DELAY,5),".",!
End DoDot:1
GOTO DATES
+22 KILL DIR
SET DIR(0)="Y"
+23 SET DIR("A")="Do you want these visits transmitted to the Data Center"
+24 SET DIR("?",1)="Answer YES if the data range you have selected is for"
+25 SET DIR("?",2)="the current fiscal year. You WILL want those visits"
+26 SET DIR("?",3)="transmitted to DDPS."
SET DIR("?",4)=" "
+27 SET DIR("?",5)="Answer NO if you are running this for past fiscal years."
+28 SET DIR("?")=" "
DO ^DIR
IF Y=U
QUIT
+29 ;
+30 WRITE !!,"Search begun"
+31 DO START(Y)
+32 WRITE !!,"Search COMPLETED. ",+$GET(APCDCNT)," Visits fixed."
+33 QUIT
+34 ;
+35 ;
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 imms
+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 imm visit
IF '$DATA(^AUPNVIMM("AD",APCDV))
QUIT
+12 ;only ambulatory
SET X=$$VALI^XBDIQ1(9000010,APCDV,.07)
IF (X'="A")
IF (X'="S")
QUIT
+13 ;S X=$O(^AUPNVIMM("AD",APCDV,0)) I X,$$GET1^DIQ(9000010.09,X,1204)\1=APCDT\1 Q ;if ordered on same date, quit
+14 ;S X=$O(^AUPNVIMM("AD",APCDV,0)) I X,($P($P($G(^AUPNVIMM(X,12)),U,11),".")=$P(APCDT,".")) Q
+15 ;
+16 ;D LINK(APCDV) ;link to original visit
+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///I"
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,APCDIMM,ORDT,ORDPRV,DFN,DATE,PRV,ORDV,LINK
+2 ;
+3 ; -- get first rx entry for visit
+4 SET APCDIMM=$ORDER(^AUPNVIMM("AD",APCDVST,0))
IF 'APCDIMM
QUIT
+5 KILL APCDX
DO ENP^XBDIQ1(9000010.11,APCDIMM,".02;1204;1211","APCDX(","I")
+6 ;order date
SET ORDT=APCDX(1211,"I")
IF ORDT=""
QUIT
+7 ;ordering provider
SET ORDPRV=APCDX(1204,"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 imm 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////"_$$IMMCLN
DO ^DIE
End DoDot:1
+11 ;
+12 ; -- create purpose of visit entry
+13 ; -- uses imm code from V immumization entries
+14 SET APCDIMM=0
FOR
SET APCDIMM=$ORDER(^AUPNVIMM("AD",AUPNVSIT,APCDIMM))
IF APCDIMM'=+APCDIMM
QUIT
Begin DoDot:1
+15 KILL APCDALVR
+16 SET APCDALVR("APCDPAT")=DFN
SET APCDALVR("APCDVSIT")=AUPNVSIT
+17 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
+18 SET APCDI=$PIECE(^AUPNVIMM(APCDIMM,0),U)
SET I=$PIECE(^AUTTIMM(APCDI,0),U,14)
+19 SET APCDALVR("APCDTPOV")=$$CODE($$VD^APCLV(AUPNVSIT))
+20 SET APCDALVR("APCDTNQ")=$PIECE(^AUTTIMM(APCDI,0),U)_" ***IMMUNIZATION***"
+21 DO ^APCDALVR
End DoDot:1
+22 ;
+23 ; -- create v provider entry
+24 ; -- uses immprov (1204 field value)
+25 KILL APCDIMPR
+26 SET APCDIMM=0
FOR
SET APCDIMM=$ORDER(^AUPNVIMM("AD",AUPNVSIT,APCDIMM))
IF APCDIMM'=+APCDIMM
QUIT
Begin DoDot:1
+27 KILL APCDALVR
+28 SET APCDALVR("APCDPAT")=DFN
SET APCDALVR("APCDVSIT")=AUPNVSIT
+29 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
+30 SET APCDX=$PIECE($GET(^AUPNVIMM(APCDIMM,12)),U,4)
+31 IF 'APCDX
QUIT
+32 IF $$PROVP=6
SET APCDX=$PIECE(^VA(200,APCDX,0),U,16)
+33 ;already have this provider
IF $DATA(APCDIMPR(APCDX))
QUIT
+34 SET APCDALVR("APCDTPRO")="`"_APCDX
+35 SET APCDALVR("APCDTPS")=$SELECT($DATA(APCDIMPR):"S",1:"P")
+36 DO ^APCDALVR
+37 IF '$DATA(APCDALVR("APCDAFLG"))
SET APCDIMPR(APCDX)=""
End DoDot:1
+38 ;stuff 1111 field of visit with reviewed status
+39 SET DA=AUPNVSIT
SET DIE="^AUPNVSIT("
SET DR="1111///R"
DO ^DIE
KILL DIE,DA,DR
+40 QUIT
CODE(D) ;
+1 NEW C
+2 SET C=$$IMP^AUPNSICD(D)
+3 IF C=30
QUIT "Z41.8"
+4 QUIT "V07.9"
+5 ;
RVDT(X) ; -- returns reverse date
+1 QUIT 9999999-X
+2 ;
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 ;
IMMCLN() ; -- returns ien for imm clinic code
+1 QUIT +$ORDER(^DIC(40.7,"C","12",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
