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

APCDRLR.m

Go to the documentation of this file.
  1. APCDRLR ; IHS/CMI/LAB - report of visits re-linked ;
  1. ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1. ;
  1. ;
  1. START ;EP - called from option
  1. D XIT
  1. W:$D(IOF) @IOF
  1. W !!,"This option will print a list of visits on which a V File (ancillary"
  1. W !,"data item was 'moved' or 're-linked' from one visit to another during the"
  1. W !,"nightly visit re-linker process or during the post data entry visit re-linking"
  1. W !,"process.",!
  1. W !,"You will be asked to enter the date range on which the nightly"
  1. W !,"visit re-linker was run.",!
  1. ;
  1. GETDATES ;
  1. W !!,"Please enter the range of dates on which the 're-linking' occurred."
  1. BD ;get beginning date
  1. W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Date" 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)="D^"_APCDBD_":DT:EP",DIR("A")="Enter ending Date" S Y=APCDBD D DD^%DT 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 S Y=APCDBD D DD^%DT S APCDBDD=Y S Y=APCDED D DD^%DT S APCDEDD=Y
  1. DEMO ;
  1. D DEMOCHK^APCLUTL(.APCDDEMO)
  1. I APCDDEMO=-1 G BD
  1. ZIS ;
  1. S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to ",DIR("B")="P" K DA D ^DIR K DIR
  1. I $D(DIRUT) G XIT
  1. I $G(Y)="B" D BROWSE,XIT Q
  1. W !! S XBRP="PRINT^APCDRLR",XBRC="PROC^APCDRLR",XBNS="APCD*",XBRX="XIT^APCDRLR"
  1. D ^XBDBQUE
  1. D XIT
  1. Q
  1. BROWSE ;
  1. S XBRP="VIEWR^XBLM(""PRINT^APCDRLR"")"
  1. S XBNS="APCD",XBRC="PROC^APCDRLR",XBRX="XIT^APCDRLR",XBIOP=0 D ^XBDBQUE
  1. Q
  1. ;
  1. PROC ;EP - called from xbdbque
  1. ;loop through all visits in date range and look for problem 8-8.9 or visit type of N
  1. S APCDJOB=$J,APCDTOT=0,APCDBT=$H
  1. D XTMP("APCDRLR","LIST FROM VISIT RELINKER")
  1. S X1=APCDBD,X2=-1 D C^%DTC S APCDSD=X
  1. S APCDODAT=APCDSD_".9999" F S APCDODAT=$O(^APCDKLOG("B",APCDODAT)) Q:APCDODAT=""!((APCDODAT\1)>APCDED) D
  1. .S APCDR=0 F S APCDR=$O(^APCDKLOG("B",APCDODAT,APCDR)) Q:APCDR'=+APCDR D
  1. ..S F=$P(^APCDKLOG(APCDR,0),U,5) I F,$D(^AUPNVSIT(F,0)) Q:$$DEMO^APCLUTL($P(^AUPNVSIT(F,0),U,5),APCDDEMO)
  1. ..S ^XTMP("APCDRLR",APCDJOB,APCDBT,"VISITS",APCDODAT,APCDR)="",APCDTOT=APCDTOT+1
  1. Q
  1. PRINT ;EP - called from xbdbque
  1. K APCDQ S APCDPG=0
  1. I '$D(^XTMP("APCDRLR",APCDJOB,APCDBT,"VISITS")) D HEADER W !!,"There are no visits in the Visit Relinker Log for that time period.",! Q
  1. D HEADER
  1. S APCDD=0 F S APCDD=$O(^XTMP("APCDRLR",APCDJOB,APCDBT,"VISITS",APCDD)) Q:APCDD=""!($D(APCDQ)) D
  1. .I $Y>(IOSL-5) D HEADER Q:$D(APCDQ)
  1. .W !!,"Date of Visit Relinker: ",$$FMTE^XLFDT(APCDD)
  1. .S APCDR=0 F S APCDR=$O(^XTMP("APCDRLR",APCDJOB,APCDBT,"VISITS",APCDD,APCDR)) Q:APCDR'=+APCDR!($D(APCDQ)) D
  1. ..I $Y>(IOSL-5) D HEADER Q:$D(APCDQ)
  1. ..S APCDN=^APCDKLOG(APCDR,0)
  1. ..S APCDTV=$P(APCDN,U,5)
  1. ..S DFN=$P($G(^AUPNVSIT(APCDTV,0)),U,5)
  1. ..W !!,$$HRN^AUPNPAT(DFN,DUZ(2)),?7,$E($P(^DPT(DFN,0),U),1,18),?25,$$FMTE^XLFDT($P(^AUPNVSIT(APCDTV,0),U),2)," (",APCDTV,")",?53,$$FMTE^XLFDT($P(^AUPNVSIT($P(APCDN,U,4),0),U),2)," (",$P(APCDN,U,4),")"
  1. ..W !?1,"Providers-To Visit: "
  1. ..S APCDX=0,APCDP="" F S APCDX=$O(^AUPNVPRV("AD",APCDTV,APCDX)) Q:APCDX'=+APCDX!($D(APCDQ)) D
  1. ...S APCDPRV=$P($G(^AUPNVPRV(APCDX,0)),U)
  1. ...I APCDPRV="" Q ;no provider?
  1. ...S:APCDP]"" APCDP=APCDP_"; "
  1. ...S APCDP=APCDP_$E($P(^VA(200,APCDPRV,0),U,1),1,12)
  1. ..W APCDP
  1. ..W !?1,"Data re-linked: "
  1. ..K APCDA S APCDX=0 F S APCDX=$O(^APCDKLOG(APCDR,11,APCDX)) Q:APCDX'=+APCDX D
  1. ...S F=$P(^APCDKLOG(APCDR,11,APCDX,0),U),B=$P(^DIC(F,0),U)
  1. ...S I=$P(^APCDKLOG(APCDR,11,APCDX,0),U,2)
  1. ...S P=$$VAL^XBDIQ1(F,I,1202) I P="" S P="UNKNOWN OR MISSING"
  1. ...S APCDA(B,P)=$G(APCDA(B,P))+1
  1. ..S APCDX="",APCDC=0 F S APCDX=$O(APCDA(APCDX)) Q:APCDX=""!($D(APCDQ)) D
  1. ...S APCDP="" F S APCDP=$O(APCDA(APCDX,APCDP)) Q:APCDP=""!($D(APCDQ)) D
  1. ....I $Y>(IOSL-4) D HEADER Q:$D(APCDQ)
  1. ....W:APCDC>0 ! W ?17,$E(APCDX,1,12),?31,"Ordering Prv: ",$E(APCDP,1,25),?75,"# ",APCDA(APCDX,APCDP)
  1. ....S APCDC=APCDC+1
  1. W !!,"Total # of Visits: ",APCDTOT,!
  1. K ^XTMP("APCDRLR",APCDJOB,APCDBT)
  1. XIT ;
  1. D EN^XBVK("APCD")
  1. D KILL^AUPNPAT
  1. Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1. Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1. ;----------
  1. I 'APCDPG G HEADER1
  1. I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCDQ="" Q
  1. HEADER1 ;
  1. W:$D(IOF) @IOF S APCDPG=APCDPG+1
  1. W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
  1. W !?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),?($S(80=132:120,1:72)),"Page ",APCDPG,!
  1. S APCDTEXT="Visits for which an Ancillary Data Item was 're-linked' to another visit"
  1. W !?(80-$L(APCDTEXT)/2),APCDTEXT,!
  1. S APCDTEXT="Relinking Dates: "_APCDBDD_" and "_APCDEDD
  1. W ?(80-$L(APCDTEXT)/2),APCDTEXT,!
  1. W $TR($J(" ",80)," ","-")
  1. W !,?25,"TO VISIT",?53,"FROM VISIT"
  1. W !,"HRN",?7,"PATIENT",?25,"DATE/TIME (IEN)",?53,"DATE/TIME (IEN)"
  1. W !,$TR($J(" ",80)," ","-")
  1. Q
  1. DATE(D) ;EP
  1. I D="" Q ""
  1. Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
  1. ;
  1. XTMP(N,D) ;EP - set xtmp 0 node
  1. Q:$G(N)=""
  1. S ^XTMP(N,0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_$G(D)
  1. Q
  1. ;
  1. ;
  1. PURGERL ;EP - CALLED FROM OPTION
  1. D INIT
  1. D GETDATE
  1. I $D(APCDQUIT) D EOJ Q
  1. ZIS1 W !! S %ZIS="PQ" D ^%ZIS
  1. I POP D EOJ Q
  1. I $D(IO("Q")) D TSKMN,EOJ Q
  1. DRIVER ;
  1. D PURGE
  1. W !!,"A Total of ",APCDCNT," Entries Purged.",!
  1. D EOJ
  1. Q
  1. ;
  1. INIT ;
  1. W !!,"Purge Data from Visit Relinker Log!"
  1. S APCDCNT=0
  1. K APCDQUIT
  1. Q
  1. ;
  1. GETDATE ;
  1. S Y=DT X ^DD("DD") S APCDDTP=Y
  1. S %DT("A")="Purge data up to and including what RELINKER RUN DATE? ",%DT="AEPX" W ! D ^%DT
  1. I Y=-1 S APCDQUIT="" Q
  1. S APCDPGE=Y X ^DD("DD") S APCDPGEY=Y
  1. Q
  1. ;
  1. PURGE ;
  1. S APCDX=0 F S APCDX=$O(^APCDKLOG("B",APCDX)) Q:APCDX=""!(APCDX>APCDPGE) D
  1. .S APCDY=0 F S APCDY=$O(^APCDKLOG("B",APCDX,APCDY)) Q:APCDY'=+APCDY D
  1. ..S DA=APCDY,DIK="^APCDKLOG(" D ^DIK S APCDCNT=APCDCNT+1
  1. Q
  1. ;
  1. ;
  1. TSKMN ;
  1. K ZTSAVE F %="APCDPGE","APCDCNT" S ZTSAVE(%)=""
  1. S ZTIO=ION,ZTCPU=$G(IOCPU),ZTRTN="DRIVER^APCDRLR",ZTDTH="",ZTDESC="PURGE DATA RELINKER LOG FILE" D ^%ZTLOAD
  1. Q
  1. EOJ ;
  1. K APCDCNT,APCDPGE,X,Y,DIC,DA,DIE,DR,%DT,D,D0,D1,DQ,APCDDTP,APCDPGEY,POP,APCDX,APCDDUZ,APCDY
  1. I $D(ZTQUEUED) S ZTREQ="@" K ZTSK
  1. D ^%ZISC
  1. Q