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