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

APCLSMUN.m

Go to the documentation of this file. 
  1. APCLSMUN ; IHS/CMI/LAB - NIGHTLY MY SYNDROMIC SURV EXPORT
  1.  ;;3.0;IHS PCC REPORTS;**22,23,24,25,26,27,28,29,30**;FEB 05, 1997;Build 27
  1.  ;
  1.  ;
  1. START ;
  1.  ;MUS SYNDROMIC SURV EXPORT
  1.  ;runs nightly and should be scheduled at 12:05am
  1.  ;gathers all ER and URGENT CARE visits that were modified since the last export
  1.  ;1st run goes back 24 hours
  1.  ;
  1.  ;
  1.  D EN^XBVK("APCL")
  1.  S APCLSITE=$P($G(^AUTTSITE(1,0)),U,1)
  1.  I DUZ(2)'=APCLSITE Q  ;MUST BE SCHEDULED AS MAIN SITE
  1.  S APCLDBID=$$GET1^DIQ(9999999.06,APCLSITE,.32)
  1.  S APCL1ST=$P($G(^APCLILIC(1,0)),U,6)
  1.  S APCLLAST="",APCLEXTY="R"
  1.  ;FIND LAST LOG ENTRY
  1.  S X=0 F  S X=$O(^APCLMUSS(X)) Q:X'=+X  I $P(^APCLMUSS(X,0),U,7)="R" S APCLLAST=X
  1.  I 'APCLLAST D  I 1
  1.  .S APCLBD=$$FMADD^XLFDT(DT,-1)
  1.  .S APCLED=$$FMADD^XLFDT(DT,-1)
  1.  E  D
  1.  .S APCLL=$P(^APCLMUSS(APCLLAST,0),U,4)  ;LAST END
  1.  .I APCL1ST S APCLBD=$$FMADD^XLFDT(APCLL,1)
  1.  .I 'APCL1ST S APCLBD=$$FMADD^XLFDT(APCLL,1)
  1.  .S APCLED=$$FMADD^XLFDT(DT,-1)	;
  1. PROC ;EP - called from xbdbque
  1.  K ^XTMP("APCMUSS",$J)
  1.  ;CREATE LOG ENTRY
  1.  S X=$$NOW^XLFDT(),DIC(0)="L",DIC("DR")=".02////"_APCLSITE_";.03////"_APCLBD_";.04////"_APCLED_";.07///"_APCLEXTY,DIC="^APCLMUSS(" K DO,D0 D FILE^DICN K DA,DIC
  1.  I Y=-1 Q
  1.  S APCLLOG=+Y
  1.  ;
  1.  S APCLVD=$$FMADD^XLFDT(APCLBD,-1)_".9999"
  1.  F  S APCLVD=$O(^AUPNVSIT("ADLM",APCLVD)) Q:APCLVD'=+APCLVD!($P(APCLVD,".")>APCLED)  D
  1.  .S APCLV=0 F  S APCLV=$O(^AUPNVSIT("ADLM",APCLVD,APCLV)) Q:APCLV'=+APCLV  D
  1.  ..Q:'$D(^AUPNVSIT(APCLV,0))
  1.  ..Q:$P(^AUPNVSIT(APCLV,0),U,11)
  1.  ..S APCLRS=$S($D(^APCLMUSS("C",APCLV)):"M",1:"A")
  1.  ..D PROC1
  1.  ;NOW GO BACK THROUGH ADLM AND FIND ANY H WITH AN ER
  1.  S APCLVD=$$FMADD^XLFDT(APCLBD,-1)_".9999"
  1.  F  S APCLVD=$O(^AUPNVSIT("ADLM",APCLVD)) Q:APCLVD'=+APCLVD!($P(APCLVD,".")>APCLED)  D
  1.  .S APCLV=0 F  S APCLV=$O(^AUPNVSIT("ADLM",APCLVD,APCLV)) Q:APCLV'=+APCLV  D
  1.  ..Q:'$D(^AUPNVSIT(APCLV,0))
  1.  ..Q:$P(^AUPNVSIT(APCLV,0),U,11)
  1.  ..Q:$P(^AUPNVSIT(APCLV,0),U,7)'="H"
  1.  ..S DFN=$P(^AUPNVSIT(APCLV,0),U,5)
  1.  ..Q:DFN=""
  1.  ..Q:'$D(^DPT(DFN,0))
  1.  ..Q:$P(^DPT(DFN,0),U)["DEMO,PATIENT"
  1.  ..Q:$$DEMO^APCLUTL(DFN,"E")
  1.  ..S APCLERV=$$ERV(APCLV) I 'APCLERV Q   ;quit if no ER/UC within 2 days of the H admission date
  1.  ..S APCLRS=$S($D(^APCLMUSS("C",APCLERV)):"M",1:"A")
  1.  ..S ^XTMP("APCLMUSS",$J,APCLERV)=APCLRS_U_APCLV
  1.  ..;I DUZ=2881 W !!,APCLERV,"  H: ",APCLV
  1.  ;	
  1.  ;NOW GO THROUGH AVDEL XREF FOR DELETES SKIP IF THIS IS A FULL EXPORT
  1.  S APCLVD=$$FMADD^XLFDT(APCLBD,-1)_".9999"
  1.  F  S APCLVD=$O(^AUPNVSIT("AVDEL",APCLVD)) Q:APCLVD'=+APCLVD!($P(APCLVD,".")>APCLED)  D
  1.  .;W:'$D(ZTQUEUED) ".",$$FMTE^XLFDT(APCLSD)
  1.  .S APCLV=0 F  S APCLV=$O(^AUPNVSIT("AVDEL",APCLVD,APCLV)) Q:APCLV'=+APCLV  D
  1.  ..I '$D(^APCLMUSS("C",APCLV)) Q  ;never exported so no need to send delete
  1.  ..S APCLRS="D"
  1.  ..D PROC1
  1.  D GENHL7
  1.  ;UPDATE/REINDEX LOG
  1.  S DA=APCLLOG,DIK="^APCLMUSS(" D IXALL^DIK
  1.  S DA=APCLLOG,DIE="^APCLMUSS(",DR=".05///"_APCLVCNT_";.06///"_APCLFILE D ^DIE K DA,DIE
  1.  D PURGE
  1.  D EXIT
  1.  Q
  1. ERV(H) ;is there an ER/UC Ambulatory visit within 2 days
  1.  NEW T,BD,ADMD,D,V,P,APCLVL,X,G
  1.  ;T IS # of minutes in 2 days
  1.  S G=""
  1.  S P=$P(^AUPNVSIT(H,0),U,5)  ;PATIENT
  1.  S ADMD=$$VDTM^APCLV(H)  ;visit date/time in fileman format
  1.  S BD=$$FMADD^XLFDT($P(ADMD,"."),-2)
  1.  K APCLVL
  1.  D ALLV^APCLAPIU(P,$P(BD,"."),$P(ADMD,"."),"APCLVL")
  1.  I '$O(APCLVL(0)) Q ""
  1.  S X=0 F  S X=$O(APCLVL(X)) Q:X'=+X  D
  1.  .S V=$P(APCLVL(X),U,5)
  1.  .Q:$P(^AUPNVSIT(V,0),U,7)'="A"
  1.  .S C=$$CLINIC^APCLV(V,"C")
  1.  .I C'=30,C'=80 Q
  1.  .;Q:$$VDTM^APCLV(V)<(BD
  1.  .Q:$$VDTM^APCLV(V)>ADMD
  1.  .S G=V
  1.  Q G
  1. PROC1 ;
  1.  Q:'$D(^AUPNVSIT(APCLV,0))
  1.  S DFN=$P(^AUPNVSIT(APCLV,0),U,5)
  1.  Q:DFN=""
  1.  Q:'$D(^DPT(DFN,0))
  1.  Q:$P(^DPT(DFN,0),U)["DEMO,PATIENT"
  1.  Q:$$DEMO^APCLUTL(DFN,"E")
  1.  I $P(^AUPNVSIT(APCLV,0),U,7)'="A",APCLRS="A" Q  ;ONLY AMBULATORY
  1.  I $P(^AUPNVSIT(APCLV,0),U,7)'="A",APCLRS="M" S APCLRS="D"  ;WENT BEFORE AND NOW DOESN'T MEET CRITERIA SO DELETE IT
  1.  S APCLCLIN=$$CLINIC^APCLV(APCLV,"C")
  1.  I APCLRS="A",APCLCLIN'=30,APCLCLIN'=80 Q  ;ONLY ER AND URGENT CARE
  1.  I APCLRS="M",APCLCLIN'=30,APCLCLIN'=80 S APCLRS="D"  ;WENT BEFORE AND CLINIC HAS BEEN CHANGED SO SEND DELETE
  1.  S ^XTMP("APCLMUSS",$J,APCLV)=APCLRS
  1.  Q
  1.  ;
  1. GENHL7 ;
  1.  ;LOOP THROUGH ^XTMP("APCLMUSS",$J,visitien)
  1.  ;IF YOU EXPORT THE VISIT SET A VISIT COUNTER APCLVCNT=APCLVCNT+1
  1.  ;S APCLFILE=filenmame used for export
  1.  ;IF YOU EXPORT THE VISIT SET THE LOG 11 MULTIPLE D LOG^APCLSMUN(APCLLOG,VISITIEN,APCLRS)
  1.  N APCLDA,APCLREC,APCLPAT,APCLSEVN
  1.  N IVDT,EVDT,HVST
  1.  S APCLVCNT=0,APCLFILE=""
  1.  Q:'$D(^XTMP("APCLMUSS",$J))
  1.  D HL7^APCLSMU2
  1.  ;DO THE HL7 MSG GENERATION HERE
  1.  Q
  1. LOG(LOG,VISIT,STAT) ;EP - SET VISIT EXPORT MULTIPLE OF LOG
  1.  I '$G(LOG) Q
  1.  I '$D(^APCLMUSS(LOG,0)) Q
  1.  S:'$D(^APCLMUSS(LOG,11,0)) ^APCLMUSS(LOG,11,0)="^9001003.421101PA"
  1.  S ^APCLMUSS(LOG,11,VISIT,0)=VISIT_"^"_STAT
  1.  Q
  1. DATE(D) ;EP
  1.  Q (1700+$E(D,1,3))_$E(D,4,5)_$E(D,6,7)
  1.  ;
  1. JDATE(D) ;EP - get date
  1.  I $G(D)="" Q ""
  1.  NEW A
  1.  S A=$$FMTE^XLFDT(D)
  1.  Q $E(D,6,7)_$$UP^XLFSTR($P(A," ",1))_(1700+$E(D,1,3))
  1.  ;
  1. UID(APCLA) ;Given DFN return unique patient record id.
  1.  I '$G(APCLA) Q ""
  1.  I '$D(^AUPNPAT(APCLA)) Q ""
  1.  ;
  1.  Q $$GET1^DIQ(9999999.06,$P(^AUTTSITE(1,0),U),.32)_$E("0000000000",1,10-$L(APCLA))_APCLA
  1.  ;
  1. EXIT ;clean up and exit
  1.  D EN^XBVK("APCL")
  1.  D ^XBFMK
  1.  K ^XTMP("APCLMUSS",$J)
  1.  Q
  1.  
  1. PURGE ;
  1.  W:'$D(ZTQUEUED) !!,"Now cleaning up host files older than 7 DAYS"
  1.  K APCLFILE,APCLDIR
  1.  S APCLDIR=$P($G(^AUTTSITE(1,1)),"^",2)
  1.  I APCLDIR="" S APCLDIR=$P($G(^XTV(8989.3,1,"DEV")),"^",1)
  1.  I APCLDIR="" Q
  1.  S APCLASU=$P($G(^AUTTLOC($P(^AUTTSITE(1,0),U),0)),U,10)
  1.  S APCLDT=$$FMADD^XLFDT(DT,-31)
  1.  S APCLDT=$$DATE^APCLSILI(APCLDT)
  1.  S APCLFLST=$$LIST^%ZISH(APCLDIR,"MU2_"_APCLASU_"*",.APCLFILE)
  1.  Q:'$O(APCLFILE(""))
  1.  S APCLX=0 F  S APCLX=$O(APCLFILE(APCLX)) Q:APCLX'=+APCLX  D
  1.  .S D=$P($P(APCLFILE(APCLX),"."),"_",3)
  1.  .I D<APCLDT S N=APCLFILE(APCLX) S APCLM=$$DEL^%ZISH(APCLDIR,N)
  1.  Q
  1.  ;
  1. DATEXP ;-- ask the date range
  1.  D EN^XBVK("APCL")
  1.  S APCLSITE=$P($G(^AUTTSITE(1,0)),U,1)
  1.  I DUZ(2)'=APCLSITE Q  ;MUST BE SCHEDULED AS MAIN SITE
  1.  S APCLDBID=$$GET1^DIQ(9999999.06,APCLSITE,.32)
  1.  S %DT="AE",%DT("A")="Begin Date: "
  1.  D ^%DT
  1.  I Y<0 D EXIT Q
  1.  S APCLBD=+Y
  1.  S %DT="AE",%DT("A")="End Date: "
  1.  D ^%DT
  1.  I Y<0 D EXIT Q
  1.  S APCLED=+Y
  1.  S APCLEXTY="D"
  1.  G PROC
  1.  Q
  1.  ;
  1.  
  1.