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

APCDDVE.m

Go to the documentation of this file. 
  1. APCDDVE ; IHS/CMI/LAB - AUTO MERGE E VISITS ;
  1.  ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1.  ;
  1. START ;EP - called from option
  1.  W:$D(IOF) @IOF
  1.  W !!,"This option will go through the visit file, find all instances where there",!,"are 2 'E - Historical Event' visits on the same day to the same location",!,"and AUTOMATICALLY merge them together.",!
  1.  W !,"You will be asked for a date range for which to run this report.",!,"It takes a long time to process so you may want to queue it to run after hours."
  1.  W !,"You may optionally receive a report detailing which visits where merged ",!,"together.",!!
  1. RDPV ; Determine to run by Posting date or Visit date
  1.  S APCDBEEP=$C(7)_$C(7),APCDSITE="" S:$D(DUZ(2)) APCDSITE=DUZ(2)
  1.  I '$D(DUZ(2)) S APCDSITE=+^AUTTSITE(1,0)
  1.  S DIR(0)="S^1:Posting Date;2:Visit Date",DIR("A")="Run Report by",DIR("B")="P" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) G XIT
  1.  S Y=$E(Y),APCDPROC=$S(Y=1:"P",Y=2:"V",1:Y)
  1. GETDATES ;
  1. BD ;get beginning date
  1.  W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning "_$S(APCDPROC="P":"Posting",APCDPROC="V":"Visit",1:"Posting")_" Date for Search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) G XIT
  1.  S APCDBD=Y
  1. ED ;get ending date
  1.  W ! S DIR(0)="DA^"_APCDBD_":DT:EP",DIR("A")="Enter ending "_$S(APCDPROC="P":"Posting",APCDPROC="V":"Visit",1:"Posting")_" Date for Search: " S Y=APCDBD D DD^%DT S DIR("B")=Y,Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) G BD
  1.  S APCDED=Y
  1.  S X1=APCDBD,X2=-1 D C^%DTC S APCDSD=X
  1.  ;
  1. REPORT ;
  1.  S APCDRPT=""
  1.  S DIR(0)="Y",DIR("A")="Would you like a report of those visits that were merged?",DIR("B")="Y" K DA D ^DIR K DIR
  1.  G:$D(DIRUT) GETDATES
  1.  S APCDRPT=Y
  1. ZIS ;call xbdbque
  1.  S XBRC="DRIVER^APCDDVE",XBRP="PRINT^APCDDVE",XBRX="XIT^APCDDVE",XBNS="APCD"
  1.  D ^XBDBQUE
  1.  D XIT
  1.  Q
  1. DRIVER ;EP entry point for taskman
  1.  S APCDBT=$H,APCDJOB=$J,APCDC=0
  1.  K ^XTMP("APCDDVE",APCDJOB,APCDBT)
  1.  I APCDRPT S:'$D(^XTMP("APCDDVE",0)) ^XTMP("APCDDVE",0)="" S $P(^XTMP("APCDDVE",0),U)=$$FMADD^XLFDT(DT,7),$P(^XTMP("APCDDVE",0),U,2)=DT,$P(^XTMP("APCDDVE",0),U,3)="PCC E VISIT AUTO MERGE"
  1.  D PROCESS
  1.  S APCDET=$H
  1.  Q
  1. PRINT ;EP
  1.  S APCDQUIT=0,APCDPG=0
  1.  G:'APCDRPT DONE
  1.  D @("HEAD"_(2-($E(IOST,1,2)="C-")))
  1.  I '$D(^XTMP("APCDDVE",APCDJOB,APCDBT)) W !!,"NO Event Visits in the date range were auto merged.",! G DONE
  1.  S APCDC=0 F  S APCDC=$O(^XTMP("APCDDVE",APCDJOB,APCDBT,"E MERGE",APCDC)) Q:APCDC'=+APCDC!(APCDQUIT)  D PRN1
  1. DONE ;
  1.  I 'APCDQUIT,$E(IOST)="C",IO=IO(0) S DIR(0)="E" D ^DIR K DIR
  1.  W:$D(IOF) @IOF
  1.  K ^XTMP("APCDDVE",APCDJOB,APCDBT)
  1.  D XIT
  1.  Q
  1. PRN1 ;print each set of visits
  1.  I $Y>(IOSL-5) D HEAD Q:APCDQUIT
  1.  S F=^XTMP("APCDDVE",APCDJOB,APCDBT,"E MERGE",APCDC,"FROM")
  1.  S T=^XTMP("APCDDVE",APCDJOB,APCDBT,"E MERGE",APCDC,"TO")
  1.  W !!,"FROM VISIT: ",?14,$$FMTE^XLFDT($P($P(F,U),"."),"5D"),?26,$$HRN^AUPNPAT($P(F,U,4),DUZ(2),2),?41,$P(^AUTTLOC($P(F,U,5),0),U,7),?47,$P(F,U,6),?65,$P(F,U,7)
  1.  F X=8:1:1 Q:$P(^XTMP("APCDDVE",APCDJOB,APCDBT,"E MERGE",APCDC,"FROM"),U,X)=""  W !,?65,$P(^XTMP("APCDDVE",APCDJOB,APCDBT,"E MERGE",APCDC,"FROM"),U,X)
  1.  W !,"  TO VISIT: ",?14,$$FMTE^XLFDT($P(T,U),"5D"),?26,$$HRN^AUPNPAT($P(T,U,4),DUZ(2),2),?41,$P(^AUTTLOC($P(T,U,5),0),U,7),?47,$P(T,U,6),?65,$P(T,U,7)
  1.  F X=8:1:1 Q:$P(^XTMP("APCDDVE",APCDJOB,APCDBT,"E MERGE",APCDC,"TO"),U,X)=""  W !,?65,$P(^XTMP("APCDDVE",APCDJOB,APCDBT,"E MERGE",APCDC,"TO"),U,X)
  1.  Q
  1. XIT ;EP
  1.  K APCDVSIT,APCDV,APCDPG,APCDQUIT,APCDODAT,APCDED,APCDSD,APCDBD,APCDBT,APCDJOB,APCDVREC,APCDC,APCDP,APCDBDFN,APCDBEEP,APCDET,APCDPROC,APCDRPT,APCDSITE,DFN
  1.  K X,X1,X2,IO("Q"),%DT,%ZIS,%,DUOUT,DLOUT,Y
  1.  Q
  1. PROCESS ;process report
  1.  D @APCDPROC
  1.  Q
  1. P ; Run by Posting date  
  1.  S APCDBDFN=$O(^AUPNVSIT("AMRG",APCDSD)) Q:APCDBDFN=""  S APCDBDFN=$O(^AUPNVSIT("AMRG",APCDBDFN,""))
  1.  S APCDVSIT=APCDBDFN-1 F  S APCDVSIT=$O(^AUPNVSIT(APCDVSIT)) Q:APCDVSIT'=+APCDVSIT  Q:$P(^AUPNVSIT(APCDVSIT,0),U,2)>APCDED  D PROC
  1.  Q
  1. PV ;
  1.  S APCDVSIT="" F  S APCDVSIT=$O(^AUPNVSIT("ADWO",APCDODAT,APCDVSIT)) Q:APCDVSIT'=+APCDVSIT  D PROC
  1.  Q
  1. V ; Run by visit date
  1.  S APCDODAT=$O(^AUPNVSIT("B",APCDSD)) Q:APCDODAT=""
  1.  S APCDODAT=APCDSD_".9999" F  S APCDODAT=$O(^AUPNVSIT("B",APCDODAT)) Q:APCDODAT=""!((APCDODAT\1)>APCDED)  D V1
  1.  Q
  1. V1 ;
  1.  S APCDVSIT="" F  S APCDVSIT=$O(^AUPNVSIT("B",APCDODAT,APCDVSIT)) Q:APCDVSIT'=+APCDVSIT  I $D(^AUPNVSIT(APCDVSIT,0)) D PROC
  1.  Q
  1. PROC ;
  1.  Q:'$P(^AUPNVSIT(APCDVSIT,0),U,9)  ;no dependent entry count
  1.  Q:$P(^AUPNVSIT(APCDVSIT,0),U,2)=""  ;no posting date
  1.  Q:$P(^AUPNVSIT(APCDVSIT,0),U,11)  ;deleted visit
  1.  Q:$P(^AUPNVSIT(APCDVSIT,0),U,7)'="E"  ;only process service category of E
  1.  S APCDVREC=^AUPNVSIT(APCDVSIT,0),DFN=$P(APCDVREC,U,5)
  1.  D MRG
  1.  Q
  1. MRG ;find all visits that could be merged to visit in APCDVSIT
  1.  S APCDV=0 F  S APCDV=$O(^AUPNVSIT("AC",DFN,APCDV)) Q:APCDV=""  D
  1.  .Q:$P(^AUPNVSIT(APCDV,0),U,11)  ;deleted
  1.  .Q:$P(^AUPNVSIT(APCDV,0),U,7)'="E"  ;not E
  1.  .Q:'$P(^AUPNVSIT(APCDV,0),U,9)  ;0 entries
  1.  .Q:APCDV=APCDVSIT  ;don't merge to self
  1.  .I $$VD^APCLV(APCDV,"I")'=$$VD^APCLV(APCDVSIT,"I") Q  ;not same date
  1.  .Q:$P(^AUPNVSIT(APCDV,0),U,3)'=$P(APCDVREC,U,3)
  1.  .Q:$P(^AUPNVSIT(APCDV,0),U,5)'=$P(APCDVREC,U,5)
  1.  .Q:$P(^AUPNVSIT(APCDV,0),U,6)'=$P(APCDVREC,U,6)
  1.  .S X=$P($G(^AUPNVSIT(APCDV,21)),U),Y=$P($G(^AUPNVSIT(APCDVSIT,21)),U) I X'=Y Q  ;outside locations not the same
  1.  . D SETTMP
  1.  . D MRG1
  1.  Q
  1. MRG1 ;call visit merge utility
  1.  S APCDVMT=APCDVSIT,APCDVMF=APCDV D ^APCDVM2
  1.  S $P(^AUPNVSIT(APCDVMF,22),U)="AUTO EVENT VISIT MERGE"
  1.  D UPDLOG^APCDVDEL(APCDVMF,APCDVMT)
  1.  S AUPNVSIT=APCDVMF D DEL^AUPNVSIT
  1.  K APCDVMT,APCDVMF,AUPNVSIT
  1.  Q
  1. SETTMP ;set tmp for report
  1.  Q:'APCDRPT
  1.  S APCDC=APCDC+1,%1=0,^XTMP("APCDDVE",APCDJOB,APCDBT,"E MERGE",APCDC,"TO")="" F %=.01,.02,.03,.05,.06,2101 S %1=%1+1,$P(^XTMP("APCDDVE",APCDJOB,APCDBT,"E MERGE",APCDC,"TO"),U,%1)=$$VALI^XBDIQ1(9000010,APCDVSIT,%)
  1.  S APCDP=6,APCDVFLE=9000010,APCDVIST=APCDVSIT F  S APCDVFLE=$O(^DIC(APCDVFLE)) Q:APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE)  D DE2
  1.  S %1=0,^XTMP("APCDDVE",APCDJOB,APCDBT,"E MERGE",APCDC,"FROM")="" F %=.01,.02,.03,.05,.06,2101 S %1=%1+1,$P(^XTMP("APCDDVE",APCDJOB,APCDBT,"E MERGE",APCDC,"FROM"),U,%1)=$$VALI^XBDIQ1(9000010,APCDVSIT,%)
  1.  S APCDP=6,APCDVFLE=9000010,APCDVIST=APCDV F  S APCDVFLE=$O(^DIC(APCDVFLE)) Q:APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE)  D DE2
  1.  Q
  1.  ;
  1. DE2 ;
  1.  S APCDVDG=^DIC(APCDVFLE,0,"GL"),APCDVIGR=APCDVDG_"""AD"",APCDVIST,APCDVDFN)"
  1.  S APCDVDFN="" I $O(@APCDVIGR)]"" S APCDP=APCDP+1,$P(^XTMP("APCDDVE",APCDJOB,APCDBT,"E MERGE",APCDC,"FROM"),U,APCDP)=$P($P(^DIC(APCDVFLE,0),U),"V ",2)
  1.  Q
  1.  ;
  1.  I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCDQUIT="" Q
  1. HEAD1 ;
  1.  W:$D(IOF) @IOF
  1. HEAD2 ;
  1.  S APCDPG=APCDPG+1
  1.  W !,$P(^VA(200,DUZ,0),U,2),?50,$$FMTE^XLFDT(DT),?72,"Page ",APCDPG,!
  1.  W !?29,"PCC Data Entry Module"
  1.  W !?23,"*********************************"
  1.  W !?23,"*   VISIT REVIEW ERROR REPORT   *"
  1.  W !?23,"*********************************"
  1.  S X="PCC DATA ENTRY AUTO MERGE EVENT VISIT REPORT"
  1.  W !?((80-$L(X))/2),X
  1.  W !!,"Report of Visits Merged for ",$S(APCDPROC="P":"Posting",APCDPROC="V":"VISIT",1:"Posting")," Date Range: ",$$FMTE^XLFDT(APCDBD,"5D")," through ",$$FMTE^XLFDT(APCDED,"5D")
  1.  W !,$TR($J(" ",80)," ","-")
  1.  Q