BCDMSNDR ; ILC/ABQ/JLG - CDMP SEND HL7 MESSAGE;JUL 16, 2008 3:19 PM
;;1.0;IHS CHRONIC DISEASE MANAGEMENT;;JUN 29, 2010
;
Q
;
EP ;
;Entry point to just go through new PCC visits
;This assumes that the ACDMP X-ref has been created.
S NUMSNT=0
S (BCDMVCNT,BCDMMCNT)=0
S X1=DT
S X2=-4
D C^%DTC
S BCDMDATE=X
F S BCDMDATE=$O(^AUPNVSIT("ACDMP",BCDMDATE)) Q:'BCDMDATE D Q:NUMSNT>999
.S VISIEN=0
.F S VISIEN=$O(^AUPNVSIT("ACDMP",BCDMDATE,VISIEN)) Q:'VISIEN D ;Q:NUMSNT>999 not sure what this was for?? don't send more than 999 visits???? so commentd out
..Q:$P(^AUPNVSIT(VISIEN,0),U,11) ;deleted visit so patient wasn't really here??
..S DFN=$P(^AUPNVSIT(VISIEN,0),U,5)
..Q:DFN="" ;no patient, bad visit
..I '$$A2CHK(VISIEN) K ^AUPNVSIT("ACDMP",BCDMDATE,VISIEN) Q ;03/23/2010 check to see if this is an A2 visit if not quit
..I '$$VDT(DFN,BCDMDATE) K ^AUPNVSIT("ACDMP",BCDMDATE,VISIEN) Q ;if patient is already in file with todays date don't send again TODO
..;I '$$A2(DFN) Q ;K ^AUPNVSIT("ACDMP",BCDMDATE,VISIEN) Q ;patient never had an A2 visit so skip them ONLY GET PATIENTS THAT HAD AN A2 DURING THE RUN
..;LOOP THROUGH LAST 5 YEARS OF VISITS AND SEND FOR EACH ONE
..S BCDMBD=$E(DT,1,3)-5_$E(DT,4,7)
..K BCDMV
..S B=DFN_"^ALL VISITS;DURING "_BCDMBD_"-"_DT,E=$$START1^APCLDF(B,"BCDMV(")
..S BCDMX=0 F S BCDMX=$O(BCDMV(BCDMX)) Q:BCDMX'=+BCDMX S BCDMVIEN=$P(BCDMV(BCDMX),U,5) D
...Q:'$D(^AUPNVSIT(BCDMVIEN,0))
...Q:$P(^AUPNVSIT(BCDMVIEN,0),U,11)
...D SEND(BCDMVIEN)
.. D SET(DFN,DT) ;TODO
.. K ^AUPNVSIT("ACDMP",BCDMDATE,VISIEN) ;TODO
K NUMSNT,BCDMDATE,VISIEN,IVISIEN,SERVCAT,BCDMBD,BCDMV,B,E,V,X,BCDMVIEN
Q
;
A2CHK(V) ;-- is the visit A2
N CLN,OK
S CLN=$O(^DIC(40.7,"C","A2",0))
I $P($G(^AUPNVSIT(V,0)),U,8)=CLN Q 1
Q 0
;
A2(P) ;did patient ever have an A2 visit?
NEW BCDMG,G,C,B,E
I '$G(P) Q ""
I '$D(^AUPNVSIT("AC",P)) Q ""
S C=$O(^DIC(40.7,"C","A2",0))
I C="" Q "" ;NO A2 CLINIC CODE
S B=P_"^ALL VISITS",E=$$START1^APCLDF(B,"BCDMG(")
I '$D(BCDMG) Q ""
S (X,G)=0 F S X=$O(BCDMG(X)) Q:X'=+X!(G) S V=$P(BCDMG(X),U,5) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:$P(^AUPNVSIT(V,0),U,11)
.Q:$P(^AUPNVSIT(V,0),U,8)'=C
.S G=1 ;has an A2 visit
Q G
;
VDT(P,VDT) ;-- check to see if the patient has a record in ^BCDMPAT and the date so as not to send if not necessary
I '$O(^BCDMPAT("B",P,0)) Q 1
N BIEN
S BIEN=$O(^BCDMPAT("B",P,0))
I $P($G(^BCDMPAT(BIEN,0)),U,2)<VDT Q 1
Q 0
;
SET(P,D) ;-- set the BCDMPAT file
I '$O(^BCDMPAT("B",P,0)) D Q
. N FDA,IENS,FERR
. S IENS=""
. S IENS(1)=P
. S FDA(90520,"+1,",.01)=P
. S FDA(90520,"+1,",.02)=D
. D UPDATE^DIE("","FDA","IENS","FERR(1)")
. I $G(FERR(1)) S ERR="Error Adding Patient"
Q:$P($G(^BCDMPAT(P,0)),U,2)=D
N FDA,IENS,FERR
S IENS=P_","
S FDA(90520,IENS,.02)=D
D FILE^DIE("K","FDA","FERR(1)")
Q
;
TEST ;
;This is the test code that goes through all PCC visits.
S CS=U
S RS="~"
S SCS="&"
S ESC="\"
S VISIEN=43000
F S VISIEN=$O(^AUPNVSIT("AC",DFN,VISIEN)) Q:'VISIEN D SEND(VISIEN) Q:VISIEN>5175379
Q
;
SEND(VISIEN) ;
K INDA,INA,ID2
S INDA(VISIEN)=""
S INDA=VISIEN
S INA("VISIEN")=VISIEN
S INA("BCDMUSA")="USA"
S IENS=VISIEN_","
S INA("EVDT")=$$GET1^DIQ(9000010,IENS,.01,"E")
S DFN=$P(^AUPNVSIT(VISIEN,0),U,5)
S INDA(2,DFN)=""
S IENS=DUZ(2)_","
S ASUFAC=$$GET1^DIQ(9999999.06,IENS,.0799)
S DOMAIN=$$GET1^DIQ(9999999.06,IENS,.01,"E")
S VMEDIEN=0
F S VMEDIEN=$O(^AUPNVMED("AD",VISIEN,VMEDIEN)) Q:'VMEDIEN D
.S INDA(9000010.14,VMEDIEN)=""
.S INA("ASUFAC",VMEDIEN)=ASUFAC_"-"
S HRCN=$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
I HRCN="" D
.S DUZ2=$O(^AUPNPAT(DFN,41,0))
.Q:'DUZ2
.S IENS=DUZ2_","
.S ASUFAC2=$$GET1^DIQ(9999999.06,IENS,.0799)
.S ID2=ASUFAC2_"-"_HRCN
E S ID2=ASUFAC_"-"_HRCN
;cmi/maw 6/8/2009 changed the following for PID-3
N BCDMDA,BCDMPSTR,R,BCDMCNTR
S R="~"
S BCDMPSTR=""
S BCDMCNTR=0
S BCDMDA=0 F S BCDMDA=$O(^AUPNPAT(DFN,41,BCDMDA)) Q:'BCDMDA D
. N BCDMHRN,HRCN
. S BCDMHRN=$G(^AUPNPAT(DFN,41,BCDMDA,0))
. S HRCN=$P(BCDMHRN,U,2)
. S ASUFAC=$$GET1^DIQ(9999999.06,BCDMDA,.0799)
. I BCDMDA=DUZ(2) D
.. S BCDMCNTR=BCDMCNTR+1
.. S $P(BCDMPSTR,R,BCDMCNTR)=ASUFAC_"-"_DFN
. I BCDMDA'=DUZ(2) D
.. S BCDMCNTR=BCDMCNTR+1
.. S $P(BCDMPSTR,R,BCDMCNTR)=ASUFAC_"-"_HRCN
S INA("PATID",DFN)=BCDMPSTR
S INA("PATID",1)=BCDMPSTR
S INA("BCDUSA",DFN)="USA"
N BCDMINHF
S BCDMVCNT=BCDMVCNT+1
S BCDMINHF=$$BCDM^BHLEVENT(VISIEN,.INA) ;lori this is the call that needs to be made TODO
I $O(^AUPNVMED("AD",VISIEN,0)) D
. N BCDMMED
. S BCDMMCNT=BCDMMCNT+1
. S BCDMMED=$$BCDMMED^BHLEVENT(VISIEN,.INA) ; this sends the medication message TODO
K IENS,ASUFAC,DOMAIN,VMEDIEN,DUZ2
Q
;
SENDMED ;EP - called from option to send all visits for one patient in past 5 years
W !!,"This option is used to send all medical visits for one patient who has"
W !,"had a Diabetic Retinopathy (A2) telehealth visit. This is in support of"
W !,"the Chronic Disease Management System.",!
K DIC
S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC
I Y=-1 Q
S DFN=+Y
S BCDMBD=$E(DT,1,3)-5_$E(DT,4,7)
K BCDMV
S B=DFN_"^ALL VISITS;DURING "_BCDMBD_"-"_DT,E=$$START1^APCLDF(B,"BCDMV(")
S BCDMX=0 F S BCDMX=$O(BCDMV(BCDMX)) Q:BCDMX'=+BCDMX S BCDMVIEN=$P(BCDMV(BCDMX),U,5) D
.Q:'$D(^AUPNVSIT(BCDMVIEN,0))
.Q:$P(^AUPNVSIT(BCDMVIEN,0),U,11)
.D SEND(BCDMVIEN)
;now create A2 event visit if there is none already on file
I '$$A2(DFN) D EVSIT
K BCDMV,B,BCDMBD,BCDMVIEN,DFN,E,APCDALVR,APCDVSIT,BCDMBSDV,T
D ^XBFMK
Q
EVSIT ;EP - get/create event visit
S BCDMCLN=$O(^DIC(40.7,"C","A2",0))
I BCDMCLN="" W !!,"Clinic A2 missing from clinic stop file, notify supervisor." Q
I $L($T(^APCDAPI4)) D BSD,VFILES Q
K APCDVSIT
K APCDALVR
S APCDALVR("APCDAUTO")=""
S APCDALVR("APCDPAT")=DFN
S APCDALVR("APCDCAT")="E"
S APCDALVR("APCDLOC")=DUZ(2)
S APCDALVR("APCDCLN")="`"_BCDMCLN
S APCDALVR("APCDTYPE")=$S($P($G(^APCCCTRL(DUZ(2),0)),U,4)]"":$P(^APCCCTRL(DUZ(2),0),U,4),1:"O")
S APCDALVR("APCDDATE")=DT_".12"
D ^APCDALV
S BCDMVSIT=$G(APCDALVR("APCDVSIT"))
I $G(APCDALVR("APCDVSIT","NEW")) D DEDT^APCDEA2(BCDMVSIT)
K APCDALVR
D VFILES
Q
;
BSD ;
K BCDMIN
S BCDMIN("PAT")=DFN
S BCDMIN("VISIT DATE")=DT_".12"
S BCDMIN("SITE")=DUZ(2)
S BCDMIN("CLINIC CODE")=BCDMCLN
S BCDMIN("VISIT TYPE")=$S($P($G(^APCCCTRL(DUZ(2),0)),U,4)]"":$P(^APCCCTRL(DUZ(2),0),U,4),1:"O")
S BCDMIN("SRV CAT")="E"
S BCDMIN("TIME RANGE")=0
S BCDMIN("USR")=DUZ
K APCDALVR
K BCDMBSDV
D GETVISIT^APCDAPI4(.BCDMIN,.BCDMBSDV)
S T=$P(BCDMBSDV(0),U,2)
I T]"" W !!,"error creating event visit for this patient, notify supervisor" Q
S V=$O(BCDMBSDV(0)) S BCDMVSIT=V
I $G(BCDMBSDV(V))="ADD" D DEDT^APCDEA2(BCDMVSIT)
Q
;
VFILES ;
;create v pov with admin v code and narrative
K APCDALVR
S APCDALVR("APCDPAT")=DFN
S APCDALVR("APCDVSIT")=BCDMVSIT
S APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
S APCDALVR("APCDTPOV")="V68.9"
S APCDALVR("APCDTNQ")="EVENT VISIT CREATED TO FLAG PATIENT AS HAVING A DIABETIC RETINAL A2 VISIT"
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) W !!,"error creating V POV for event visit....notify supervisor.."
K APCDALVR
Q
;
BCDMSNDR ; ILC/ABQ/JLG - CDMP SEND HL7 MESSAGE;JUL 16, 2008 3:19 PM
+1 ;;1.0;IHS CHRONIC DISEASE MANAGEMENT;;JUN 29, 2010
+2 ;
+3 QUIT
+4 ;
EP ;
+1 ;Entry point to just go through new PCC visits
+2 ;This assumes that the ACDMP X-ref has been created.
+3 SET NUMSNT=0
+4 SET (BCDMVCNT,BCDMMCNT)=0
+5 SET X1=DT
+6 SET X2=-4
+7 DO C^%DTC
+8 SET BCDMDATE=X
+9 FOR
SET BCDMDATE=$ORDER(^AUPNVSIT("ACDMP",BCDMDATE))
IF 'BCDMDATE
QUIT
Begin DoDot:1
+10 SET VISIEN=0
+11 ;Q:NUMSNT>999 not sure what this was for?? don't send more than 999 visits???? so commentd out
FOR
SET VISIEN=$ORDER(^AUPNVSIT("ACDMP",BCDMDATE,VISIEN))
IF 'VISIEN
QUIT
Begin DoDot:2
+12 ;deleted visit so patient wasn't really here??
IF $PIECE(^AUPNVSIT(VISIEN,0),U,11)
QUIT
+13 SET DFN=$PIECE(^AUPNVSIT(VISIEN,0),U,5)
+14 ;no patient, bad visit
IF DFN=""
QUIT
+15 ;03/23/2010 check to see if this is an A2 visit if not quit
IF '$$A2CHK(VISIEN)
KILL ^AUPNVSIT("ACDMP",BCDMDATE,VISIEN)
QUIT
+16 ;if patient is already in file with todays date don't send again TODO
IF '$$VDT(DFN,BCDMDATE)
KILL ^AUPNVSIT("ACDMP",BCDMDATE,VISIEN)
QUIT
+17 ;I '$$A2(DFN) Q ;K ^AUPNVSIT("ACDMP",BCDMDATE,VISIEN) Q ;patient never had an A2 visit so skip them ONLY GET PATIENTS THAT HAD AN A2 DURING THE RUN
+18 ;LOOP THROUGH LAST 5 YEARS OF VISITS AND SEND FOR EACH ONE
+19 SET BCDMBD=$EXTRACT(DT,1,3)-5_$EXTRACT(DT,4,7)
+20 KILL BCDMV
+21 SET B=DFN_"^ALL VISITS;DURING "_BCDMBD_"-"_DT
SET E=$$START1^APCLDF(B,"BCDMV(")
+22 SET BCDMX=0
FOR
SET BCDMX=$ORDER(BCDMV(BCDMX))
IF BCDMX'=+BCDMX
QUIT
SET BCDMVIEN=$PIECE(BCDMV(BCDMX),U,5)
Begin DoDot:3
+23 IF '$DATA(^AUPNVSIT(BCDMVIEN,0))
QUIT
+24 IF $PIECE(^AUPNVSIT(BCDMVIEN,0),U,11)
QUIT
+25 DO SEND(BCDMVIEN)
End DoDot:3
+26 ;TODO
DO SET(DFN,DT)
+27 ;TODO
KILL ^AUPNVSIT("ACDMP",BCDMDATE,VISIEN)
End DoDot:2
End DoDot:1
IF NUMSNT>999
QUIT
+28 KILL NUMSNT,BCDMDATE,VISIEN,IVISIEN,SERVCAT,BCDMBD,BCDMV,B,E,V,X,BCDMVIEN
+29 QUIT
+30 ;
A2CHK(V) ;-- is the visit A2
+1 NEW CLN,OK
+2 SET CLN=$ORDER(^DIC(40.7,"C","A2",0))
+3 IF $PIECE($GET(^AUPNVSIT(V,0)),U,8)=CLN
QUIT 1
+4 QUIT 0
+5 ;
A2(P) ;did patient ever have an A2 visit?
+1 NEW BCDMG,G,C,B,E
+2 IF '$GET(P)
QUIT ""
+3 IF '$DATA(^AUPNVSIT("AC",P))
QUIT ""
+4 SET C=$ORDER(^DIC(40.7,"C","A2",0))
+5 ;NO A2 CLINIC CODE
IF C=""
QUIT ""
+6 SET B=P_"^ALL VISITS"
SET E=$$START1^APCLDF(B,"BCDMG(")
+7 IF '$DATA(BCDMG)
QUIT ""
+8 SET (X,G)=0
FOR
SET X=$ORDER(BCDMG(X))
IF X'=+X!(G)
QUIT
SET V=$PIECE(BCDMG(X),U,5)
Begin DoDot:1
+9 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+10 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+11 IF $PIECE(^AUPNVSIT(V,0),U,8)'=C
QUIT
+12 ;has an A2 visit
SET G=1
End DoDot:1
+13 QUIT G
+14 ;
VDT(P,VDT) ;-- check to see if the patient has a record in ^BCDMPAT and the date so as not to send if not necessary
+1 IF '$ORDER(^BCDMPAT("B",P,0))
QUIT 1
+2 NEW BIEN
+3 SET BIEN=$ORDER(^BCDMPAT("B",P,0))
+4 IF $PIECE($GET(^BCDMPAT(BIEN,0)),U,2)<VDT
QUIT 1
+5 QUIT 0
+6 ;
SET(P,D) ;-- set the BCDMPAT file
+1 IF '$ORDER(^BCDMPAT("B",P,0))
Begin DoDot:1
+2 NEW FDA,IENS,FERR
+3 SET IENS=""
+4 SET IENS(1)=P
+5 SET FDA(90520,"+1,",.01)=P
+6 SET FDA(90520,"+1,",.02)=D
+7 DO UPDATE^DIE("","FDA","IENS","FERR(1)")
+8 IF $GET(FERR(1))
SET ERR="Error Adding Patient"
End DoDot:1
QUIT
+9 IF $PIECE($GET(^BCDMPAT(P,0)),U,2)=D
QUIT
+10 NEW FDA,IENS,FERR
+11 SET IENS=P_","
+12 SET FDA(90520,IENS,.02)=D
+13 DO FILE^DIE("K","FDA","FERR(1)")
+14 QUIT
+15 ;
TEST ;
+1 ;This is the test code that goes through all PCC visits.
+2 SET CS=U
+3 SET RS="~"
+4 SET SCS="&"
+5 SET ESC="\"
+6 SET VISIEN=43000
+7 FOR
SET VISIEN=$ORDER(^AUPNVSIT("AC",DFN,VISIEN))
IF 'VISIEN
QUIT
DO SEND(VISIEN)
IF VISIEN>5175379
QUIT
+8 QUIT
+9 ;
SEND(VISIEN) ;
+1 KILL INDA,INA,ID2
+2 SET INDA(VISIEN)=""
+3 SET INDA=VISIEN
+4 SET INA("VISIEN")=VISIEN
+5 SET INA("BCDMUSA")="USA"
+6 SET IENS=VISIEN_","
+7 SET INA("EVDT")=$$GET1^DIQ(9000010,IENS,.01,"E")
+8 SET DFN=$PIECE(^AUPNVSIT(VISIEN,0),U,5)
+9 SET INDA(2,DFN)=""
+10 SET IENS=DUZ(2)_","
+11 SET ASUFAC=$$GET1^DIQ(9999999.06,IENS,.0799)
+12 SET DOMAIN=$$GET1^DIQ(9999999.06,IENS,.01,"E")
+13 SET VMEDIEN=0
+14 FOR
SET VMEDIEN=$ORDER(^AUPNVMED("AD",VISIEN,VMEDIEN))
IF 'VMEDIEN
QUIT
Begin DoDot:1
+15 SET INDA(9000010.14,VMEDIEN)=""
+16 SET INA("ASUFAC",VMEDIEN)=ASUFAC_"-"
End DoDot:1
+17 SET HRCN=$PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
+18 IF HRCN=""
Begin DoDot:1
+19 SET DUZ2=$ORDER(^AUPNPAT(DFN,41,0))
+20 IF 'DUZ2
QUIT
+21 SET IENS=DUZ2_","
+22 SET ASUFAC2=$$GET1^DIQ(9999999.06,IENS,.0799)
+23 SET ID2=ASUFAC2_"-"_HRCN
End DoDot:1
+24 IF '$TEST
SET ID2=ASUFAC_"-"_HRCN
+25 ;cmi/maw 6/8/2009 changed the following for PID-3
+26 NEW BCDMDA,BCDMPSTR,R,BCDMCNTR
+27 SET R="~"
+28 SET BCDMPSTR=""
+29 SET BCDMCNTR=0
+30 SET BCDMDA=0
FOR
SET BCDMDA=$ORDER(^AUPNPAT(DFN,41,BCDMDA))
IF 'BCDMDA
QUIT
Begin DoDot:1
+31 NEW BCDMHRN,HRCN
+32 SET BCDMHRN=$GET(^AUPNPAT(DFN,41,BCDMDA,0))
+33 SET HRCN=$PIECE(BCDMHRN,U,2)
+34 SET ASUFAC=$$GET1^DIQ(9999999.06,BCDMDA,.0799)
+35 IF BCDMDA=DUZ(2)
Begin DoDot:2
+36 SET BCDMCNTR=BCDMCNTR+1
+37 SET $PIECE(BCDMPSTR,R,BCDMCNTR)=ASUFAC_"-"_DFN
End DoDot:2
+38 IF BCDMDA'=DUZ(2)
Begin DoDot:2
+39 SET BCDMCNTR=BCDMCNTR+1
+40 SET $PIECE(BCDMPSTR,R,BCDMCNTR)=ASUFAC_"-"_HRCN
End DoDot:2
End DoDot:1
+41 SET INA("PATID",DFN)=BCDMPSTR
+42 SET INA("PATID",1)=BCDMPSTR
+43 SET INA("BCDUSA",DFN)="USA"
+44 NEW BCDMINHF
+45 SET BCDMVCNT=BCDMVCNT+1
+46 ;lori this is the call that needs to be made TODO
SET BCDMINHF=$$BCDM^BHLEVENT(VISIEN,.INA)
+47 IF $ORDER(^AUPNVMED("AD",VISIEN,0))
Begin DoDot:1
+48 NEW BCDMMED
+49 SET BCDMMCNT=BCDMMCNT+1
+50 ; this sends the medication message TODO
SET BCDMMED=$$BCDMMED^BHLEVENT(VISIEN,.INA)
End DoDot:1
+51 KILL IENS,ASUFAC,DOMAIN,VMEDIEN,DUZ2
+52 QUIT
+53 ;
SENDMED ;EP - called from option to send all visits for one patient in past 5 years
+1 WRITE !!,"This option is used to send all medical visits for one patient who has"
+2 WRITE !,"had a Diabetic Retinopathy (A2) telehealth visit. This is in support of"
+3 WRITE !,"the Chronic Disease Management System.",!
+4 KILL DIC
+5 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+6 IF Y=-1
QUIT
+7 SET DFN=+Y
+8 SET BCDMBD=$EXTRACT(DT,1,3)-5_$EXTRACT(DT,4,7)
+9 KILL BCDMV
+10 SET B=DFN_"^ALL VISITS;DURING "_BCDMBD_"-"_DT
SET E=$$START1^APCLDF(B,"BCDMV(")
+11 SET BCDMX=0
FOR
SET BCDMX=$ORDER(BCDMV(BCDMX))
IF BCDMX'=+BCDMX
QUIT
SET BCDMVIEN=$PIECE(BCDMV(BCDMX),U,5)
Begin DoDot:1
+12 IF '$DATA(^AUPNVSIT(BCDMVIEN,0))
QUIT
+13 IF $PIECE(^AUPNVSIT(BCDMVIEN,0),U,11)
QUIT
+14 DO SEND(BCDMVIEN)
End DoDot:1
+15 ;now create A2 event visit if there is none already on file
+16 IF '$$A2(DFN)
DO EVSIT
+17 KILL BCDMV,B,BCDMBD,BCDMVIEN,DFN,E,APCDALVR,APCDVSIT,BCDMBSDV,T
+18 DO ^XBFMK
+19 QUIT
EVSIT ;EP - get/create event visit
+1 SET BCDMCLN=$ORDER(^DIC(40.7,"C","A2",0))
+2 IF BCDMCLN=""
WRITE !!,"Clinic A2 missing from clinic stop file, notify supervisor."
QUIT
+3 IF $LENGTH($TEXT(^APCDAPI4))
DO BSD
DO VFILES
QUIT
+4 KILL APCDVSIT
+5 KILL APCDALVR
+6 SET APCDALVR("APCDAUTO")=""
+7 SET APCDALVR("APCDPAT")=DFN
+8 SET APCDALVR("APCDCAT")="E"
+9 SET APCDALVR("APCDLOC")=DUZ(2)
+10 SET APCDALVR("APCDCLN")="`"_BCDMCLN
+11 SET APCDALVR("APCDTYPE")=$SELECT($PIECE($GET(^APCCCTRL(DUZ(2),0)),U,4)]"":$PIECE(^APCCCTRL(DUZ(2),0),U,4),1:"O")
+12 SET APCDALVR("APCDDATE")=DT_".12"
+13 DO ^APCDALV
+14 SET BCDMVSIT=$GET(APCDALVR("APCDVSIT"))
+15 IF $GET(APCDALVR("APCDVSIT","NEW"))
DO DEDT^APCDEA2(BCDMVSIT)
+16 KILL APCDALVR
+17 DO VFILES
+18 QUIT
+19 ;
BSD ;
+1 KILL BCDMIN
+2 SET BCDMIN("PAT")=DFN
+3 SET BCDMIN("VISIT DATE")=DT_".12"
+4 SET BCDMIN("SITE")=DUZ(2)
+5 SET BCDMIN("CLINIC CODE")=BCDMCLN
+6 SET BCDMIN("VISIT TYPE")=$SELECT($PIECE($GET(^APCCCTRL(DUZ(2),0)),U,4)]"":$PIECE(^APCCCTRL(DUZ(2),0),U,4),1:"O")
+7 SET BCDMIN("SRV CAT")="E"
+8 SET BCDMIN("TIME RANGE")=0
+9 SET BCDMIN("USR")=DUZ
+10 KILL APCDALVR
+11 KILL BCDMBSDV
+12 DO GETVISIT^APCDAPI4(.BCDMIN,.BCDMBSDV)
+13 SET T=$PIECE(BCDMBSDV(0),U,2)
+14 IF T]""
WRITE !!,"error creating event visit for this patient, notify supervisor"
QUIT
+15 SET V=$ORDER(BCDMBSDV(0))
SET BCDMVSIT=V
+16 IF $GET(BCDMBSDV(V))="ADD"
DO DEDT^APCDEA2(BCDMVSIT)
+17 QUIT
+18 ;
VFILES ;
+1 ;create v pov with admin v code and narrative
+2 KILL APCDALVR
+3 SET APCDALVR("APCDPAT")=DFN
+4 SET APCDALVR("APCDVSIT")=BCDMVSIT
+5 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
+6 SET APCDALVR("APCDTPOV")="V68.9"
+7 SET APCDALVR("APCDTNQ")="EVENT VISIT CREATED TO FLAG PATIENT AS HAVING A DIABETIC RETINAL A2 VISIT"
+8 DO ^APCDALVR
+9 IF $DATA(APCDALVR("APCDAFLG"))
WRITE !!,"error creating V POV for event visit....notify supervisor.."
+10 KILL APCDALVR
+11 QUIT
+12 ;
