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

BCDMSNDR.m

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