APCDCAFC ; IHS/CMI/LAB - report on T/C VISITS WITH ANCILLARY ;
;;2.0;IHS PCC SUITE;**2,8,11**;MAY 14, 2009;Build 58
;IHS/CMI/LAB - patch 1 Y2K
;
;
START ;
D EOJ
D INFORM
I $P(^APCCCTRL(DUZ(2),0),U,12)="" W !!,"The EHR/PCC Coding Audit Start Date has not been set",!,"in the PCC Master Control file." D D EOJ Q
.W !,"Please see your Clinical Coordinator or PCC Manager."
GETCLIN ;
W !!,"Enter the clinic code for the visits you wish to mark"
W !,"as Reviewed/Complete."
K DIC
S DIC="^DIC(40.7,",DIC(0)="AEMQ" D ^DIC K DIC
I Y=-1 D EOJ Q
S APCDCLIN=+Y
GETDATES ;
BD ;get beginning date
W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Visit Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G EOJ
S APCDBD=Y
I APCDBD<$P($G(^APCCCTRL(DUZ(2),0)),U,12) D G GETDATES
.W !!,"That date is before the EHR/PCC Coding Start Date."
.W !,"Please enter a date on or after "_$$FMTE^XLFDT($P(^APCCCTRL(DUZ(2),0),U,12))
ED ;get ending date
W ! S DIR(0)="DA^"_APCDBD_":DT:EP",DIR("A")="Enter ending Visit Date: " S Y=APCDBD D DD^%DT S Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S APCDED=Y
;
SURE ;
W !!,"Are you sure you want to mark all ",$P(^DIC(40.7,APCDCLIN,0),U)," clinic visits"
W !,"in the date range ",$$FMTE^XLFDT(APCDBD)," to ",$$FMTE^XLFDT(APCDED)," as"
S DIR(0)="Y",DIR("A")="reviewed/complete",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EOJ Q
I 'Y D EOJ Q
SORT ;
S APCDCSRT=""
S DIR(0)="S^T:Terminal Digit Order;H:Health Record Number Order;D:Visit Date Order",DIR("A")="Sort the report by",DIR("B")="T" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G ED
S APCDCSRT=Y
ZIS ;call to XBDBQUE
S XBRP="PRINT^APCDCAFC",XBRC="PROCESS^APCDCAFC",XBRX="EOJ^APCDCAFC",XBNS="APCD"
D ^XBDBQUE
D EOJ
Q
;
EOJ ;
D EN^XBVK("APCD")
Q
PROCESS ;EP - called from XBDBQUE
S ^XTMP("APCDCAFC",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"APCD - AUTO COMPLETE BY CLINIC"
S APCDJ=$J,APCDBT=$H
S APCDT=APCDBD-.0001,APCDEND=APCDED+.2400
F S APCDT=$O(^AUPNVSIT("B",APCDT)) Q:'APCDT!(APCDT>APCDEND) D
. S APCDV=0
. F S APCDV=$O(^AUPNVSIT("B",APCDT,APCDV)) Q:'APCDV D
.. Q:$P($G(^AUPNVSIT(APCDV,11)),U,11)="R" ;already completed
.. Q:'$D(^AUPNVPOV("AD",APCDV))
.. S C=$$CLINIC^APCLV(APCDV)
.. I C'=APCDCLIN Q ;not clinic chosen
.. ;v = has V65.49 or V65.19 O = has other POV
.. S V=0,O=0,X=0 F S X=$O(^AUPNVPOV("AD",APCDV,X)) Q:X'=+X D
... S I=$P(^AUPNVPOV(X,0),U)
... Q:'I
... Q:'$D(^ICD9(I,0))
... S I=$P(^ICD9(I,0),U)
... I I=".9999"!(I="ZZZ.999") S V=1
.. I V Q ;has a .9999
.. S X=$$PRIMPROV^APCLV(APCDV) I X="" Q ;no primary provider
.. D ^XBFMK
.. D UPDATE
.. S APCDSORT="" D GETSORT I APCDSORT="" S APCDSORT="??"
.. S ^XTMP("APCDCAFC",APCDJ,APCDBT,"VISITS",APCDSORT,APCDV)=""
.. Q
. Q
Q
UPDATE ;
K DIC,DD,D0,DO
S X=$$NOW^XLFDT,DIC="^AUPNVCA(",DIC(0)="L",DIADD=1,DLAYGO=9000010.45,DIC("DR")=".02////"_$P(^AUPNVSIT(APCDV,0),U,5)_";.03////"_APCDV_";.04////R;.05////"_DUZ_";1216////"_$$NOW^XLFDT D FILE^DICN
K DIC,DD,D0,DIADD,DLAYGO
;ADD TO CHART AUDIT NOTES
I $D(^AUPNCANT(APCDV,0)) G WP
K DIC,DD,D0,DO
S DIC="^AUPNCANT(",X=APCDV,DIC(0)="L",DIADD=1,DLAYGO=9000095,DIC("DR")=".02////"_$P(^AUPNVSIT(APCDV,0),U,5),DINUM=X
D FILE^DICN
K DIC,DD,D0,DO,DLAYGO,DINUM,DIADD
WP ;add to word processing field
K APCDWP
S APCDWP(1)=" "
S APCDWP(2)="Marked as Reviewed/Complete by Option: Auto Complete Visits by Clinic"
S APCDWP(3)="User: "_$P(^VA(200,DUZ,0),U)_" Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT)
D WP^DIE(9000095,APCDV_",",1100,"KA","APCDWP","APCDERR")
K APCDWP
UPD1 ;
D ^XBFMK
S DIE="^AUPNVSIT(",DA=APCDV,DR="1111////R" D ^DIE K DIE,DA,DR
S AUPNVSIT=APCDV D MOD^AUPNVSIT
;
UPDATEX ;
K DIADD,DLAYGO
D ^XBFMK
Q
GETSORT ;get sort value
I APCDCSRT="D" S APCDSORT=$P(^AUPNVSIT(APCDV,0),U) Q
;I APCDCSRT="C" S APCDSORT=$$CLINIC^APCLV(APCDV,"C") Q ;clinic code
;hrn sort values
S APCDSORT=$$HRN^AUPNPAT($P(^AUPNVSIT(APCDV,0),U,5),DUZ(2))
Q:APCDCSRT'="T"
S APCDSORT=APCDSORT+10000000,APCDSORT=$E(APCDSORT,7,8)_"-"_+$E(APCDSORT,2,8)
Q
PRINT ;EP - called from XBDBQUE
S APCDQUIT="",APCDPG=0 D HDR
I '$D(^XTMP("APCDCAFC",APCDJ,APCDBT)) W !!,"NO VISITS TO REPORT",! G DONE
S APCDSORT="" F S APCDSORT=$O(^XTMP("APCDCAFC",APCDJ,APCDBT,"VISITS",APCDSORT)) Q:APCDSORT=""!(APCDQUIT) D
. S APCDV=0 F S APCDV=$O(^XTMP("APCDCAFC",APCDJ,APCDBT,"VISITS",APCDSORT,APCDV)) Q:APCDV'=+APCDV!(APCDQUIT) D
.. I $Y>(IOSL-4) D HDR Q:APCDQUIT
.. S APCDVR=^AUPNVSIT(APCDV,0)
.. W !,$E($P(^DPT($P(APCDVR,U,5),0),U),1,15),?16,$$HRN^AUPNPAT($P(APCDVR,U,5),DUZ(2)),?24,$$DATE($P($P(APCDVR,U),".")),?36,$P(APCDVR,U,7),?39,$$CLINIC^APCLV(APCDV,"C") ;Y2000
.. S APCDC=0,APCDY=0 F S APCDY=$O(^AUPNVPOV("AD",APCDV,APCDY)) Q:APCDY'=+APCDY!(APCDQUIT) D
... S APCDC=APCDC+1
... I $Y>(IOSL-3) D HDR Q:APCDQUIT
... W:APCDC>1 !
... W ?45,$$VAL^XBDIQ1(9000010.07,APCDY,.01)
.Q
DONE ;
K ^XTMP("APCDCAFC",APCDJ,APCDBT),APCDJ,APCDBT
I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report. PRESS ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
W:$D(IOF) @IOF
Q
DE ;EP;FIND DEP ENTRIES
K APCDX,APCDD S APCDC=0
S APCDVFLE=9000010 F S APCDVFLE=$O(^DIC(APCDVFLE)) Q:APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE) D DE2
Q
;
DE2 ;
I '$$DF(APCDVFLE) Q
S APCDVDG=^DIC(APCDVFLE,0,"GL"),APCDVIGR=APCDVDG_"""AD"",APCDV,APCDVDFN)"
S APCDVDFN="" I $O(@APCDVIGR)]"" S APCDC=APCDC+1,APCDX(APCDC)=$E($P($P(^DIC(APCDVFLE,0),U),"V ",2),1,3)_"'s" S Y=$O(@APCDVIGR) S $P(APCDX(APCDC),U,3)=$$VALI^XBDIQ1(APCDVFLE,Y,1211),$P(APCDX(APCDC),U,2)=$$VAL^XBDIQ1(APCDVFLE,Y,1202)
Q
;
DATE(D) ;
I D="" Q ""
Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_(1700+$E(D,1,3))
DF(F) ;
I F=9000010.09 Q 1
I F=9000010.14 Q 1
I F=9000010.22 Q 1
I F=9000010.25 Q 1
I F=9000010.31 Q 1
Q 0
HDR ;header for report
I 'APCDPG G HDR1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCDQUIT=1 Q
HDR1 ;
W:$D(IOF) @IOF S APCDPG=APCDPG+1
W $P(^VA(200,DUZ,0),U,2),$$CTR($$FMTE^XLFDT(DT)),?71,"Page ",APCDPG,!
W $$CTR($$LOC),!
W $$CTR("Visits Automatically Completed/Reviewed for Clinic: "_$P(^DIC(40.7,APCDCLIN,0),U)),!
W !?3,"PATIENT NAME",?17,"HRN",?24,"VISIT DATE",?36,"SC",?39,"CL",?45,"Purpose of Visits",!
W $TR($J(" ",80)," ","-"),!
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
INFORM ;let user know what is gong on
W:$D(IOF) @IOF
W !!,$$CTR($$LOC,80)
W !,$$CTR($$USR,80),!!
F I=1:1 S X=$P($T(INTRO+I),";;",2) Q:X="END" W !,X
K I,X
Q
INTRO ;;
;;This option is used to automatically mark as REVIEWED/COMPLETE all
;;visits to a particular clinic in a date range that you select.
;;
;;***** Please be very careful when using this option. *****
;;
;;The visits to the clinic you select must meet the following
;;criteria:
;; - Have valid (non .9999/ZZZ.999) POVs
;; - Have a primary provider
;; - Match the clinic code you select
;;
;;A list of visits that were marked as reviewed/complete
;;will be provided.
;;
;;END
APCDCAFC ; IHS/CMI/LAB - report on T/C VISITS WITH ANCILLARY ;
+1 ;;2.0;IHS PCC SUITE;**2,8,11**;MAY 14, 2009;Build 58
+2 ;IHS/CMI/LAB - patch 1 Y2K
+3 ;
+4 ;
START ;
+1 DO EOJ
+2 DO INFORM
+3 IF $PIECE(^APCCCTRL(DUZ(2),0),U,12)=""
WRITE !!,"The EHR/PCC Coding Audit Start Date has not been set",!,"in the PCC Master Control file."
Begin DoDot:1
+4 WRITE !,"Please see your Clinical Coordinator or PCC Manager."
End DoDot:1
DO EOJ
QUIT
GETCLIN ;
+1 WRITE !!,"Enter the clinic code for the visits you wish to mark"
+2 WRITE !,"as Reviewed/Complete."
+3 KILL DIC
+4 SET DIC="^DIC(40.7,"
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+5 IF Y=-1
DO EOJ
QUIT
+6 SET APCDCLIN=+Y
GETDATES ;
BD ;get beginning date
+1 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter beginning Visit Date"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO EOJ
+3 SET APCDBD=Y
+4 IF APCDBD<$PIECE($GET(^APCCCTRL(DUZ(2),0)),U,12)
Begin DoDot:1
+5 WRITE !!,"That date is before the EHR/PCC Coding Start Date."
+6 WRITE !,"Please enter a date on or after "_$$FMTE^XLFDT($PIECE(^APCCCTRL(DUZ(2),0),U,12))
End DoDot:1
GOTO GETDATES
ED ;get ending date
+1 WRITE !
SET DIR(0)="DA^"_APCDBD_":DT:EP"
SET DIR("A")="Enter ending Visit Date: "
SET Y=APCDBD
DO DD^%DT
SET Y=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET APCDED=Y
+4 ;
SURE ;
+1 WRITE !!,"Are you sure you want to mark all ",$PIECE(^DIC(40.7,APCDCLIN,0),U)," clinic visits"
+2 WRITE !,"in the date range ",$$FMTE^XLFDT(APCDBD)," to ",$$FMTE^XLFDT(APCDED)," as"
+3 SET DIR(0)="Y"
SET DIR("A")="reviewed/complete"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
DO EOJ
QUIT
+5 IF 'Y
DO EOJ
QUIT
SORT ;
+1 SET APCDCSRT=""
+2 SET DIR(0)="S^T:Terminal Digit Order;H:Health Record Number Order;D:Visit Date Order"
SET DIR("A")="Sort the report by"
SET DIR("B")="T"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
GOTO ED
+4 SET APCDCSRT=Y
ZIS ;call to XBDBQUE
+1 SET XBRP="PRINT^APCDCAFC"
SET XBRC="PROCESS^APCDCAFC"
SET XBRX="EOJ^APCDCAFC"
SET XBNS="APCD"
+2 DO ^XBDBQUE
+3 DO EOJ
+4 QUIT
+5 ;
EOJ ;
+1 DO EN^XBVK("APCD")
+2 QUIT
PROCESS ;EP - called from XBDBQUE
+1 SET ^XTMP("APCDCAFC",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"APCD - AUTO COMPLETE BY CLINIC"
+2 SET APCDJ=$JOB
SET APCDBT=$HOROLOG
+3 SET APCDT=APCDBD-.0001
SET APCDEND=APCDED+.2400
+4 FOR
SET APCDT=$ORDER(^AUPNVSIT("B",APCDT))
IF 'APCDT!(APCDT>APCDEND)
QUIT
Begin DoDot:1
+5 SET APCDV=0
+6 FOR
SET APCDV=$ORDER(^AUPNVSIT("B",APCDT,APCDV))
IF 'APCDV
QUIT
Begin DoDot:2
+7 ;already completed
IF $PIECE($GET(^AUPNVSIT(APCDV,11)),U,11)="R"
QUIT
+8 IF '$DATA(^AUPNVPOV("AD",APCDV))
QUIT
+9 SET C=$$CLINIC^APCLV(APCDV)
+10 ;not clinic chosen
IF C'=APCDCLIN
QUIT
+11 ;v = has V65.49 or V65.19 O = has other POV
+12 SET V=0
SET O=0
SET X=0
FOR
SET X=$ORDER(^AUPNVPOV("AD",APCDV,X))
IF X'=+X
QUIT
Begin DoDot:3
+13 SET I=$PIECE(^AUPNVPOV(X,0),U)
+14 IF 'I
QUIT
+15 IF '$DATA(^ICD9(I,0))
QUIT
+16 SET I=$PIECE(^ICD9(I,0),U)
+17 IF I=".9999"!(I="ZZZ.999")
SET V=1
End DoDot:3
+18 ;has a .9999
IF V
QUIT
+19 ;no primary provider
SET X=$$PRIMPROV^APCLV(APCDV)
IF X=""
QUIT
+20 DO ^XBFMK
+21 DO UPDATE
+22 SET APCDSORT=""
DO GETSORT
IF APCDSORT=""
SET APCDSORT="??"
+23 SET ^XTMP("APCDCAFC",APCDJ,APCDBT,"VISITS",APCDSORT,APCDV)=""
+24 QUIT
End DoDot:2
+25 QUIT
End DoDot:1
+26 QUIT
UPDATE ;
+1 KILL DIC,DD,D0,DO
+2 SET X=$$NOW^XLFDT
SET DIC="^AUPNVCA("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9000010.45
SET DIC("DR")=".02////"_$PIECE(^AUPNVSIT(APCDV,0),U,5)_";.03////"_APCDV_";.04////R;.05////"_DUZ_";1216////"_$$NOW^XLFDT
DO FILE^DICN
+3 KILL DIC,DD,D0,DIADD,DLAYGO
+4 ;ADD TO CHART AUDIT NOTES
+5 IF $DATA(^AUPNCANT(APCDV,0))
GOTO WP
+6 KILL DIC,DD,D0,DO
+7 SET DIC="^AUPNCANT("
SET X=APCDV
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9000095
SET DIC("DR")=".02////"_$PIECE(^AUPNVSIT(APCDV,0),U,5)
SET DINUM=X
+8 DO FILE^DICN
+9 KILL DIC,DD,D0,DO,DLAYGO,DINUM,DIADD
WP ;add to word processing field
+1 KILL APCDWP
+2 SET APCDWP(1)=" "
+3 SET APCDWP(2)="Marked as Reviewed/Complete by Option: Auto Complete Visits by Clinic"
+4 SET APCDWP(3)="User: "_$PIECE(^VA(200,DUZ,0),U)_" Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT)
+5 DO WP^DIE(9000095,APCDV_",",1100,"KA","APCDWP","APCDERR")
+6 KILL APCDWP
UPD1 ;
+1 DO ^XBFMK
+2 SET DIE="^AUPNVSIT("
SET DA=APCDV
SET DR="1111////R"
DO ^DIE
KILL DIE,DA,DR
+3 SET AUPNVSIT=APCDV
DO MOD^AUPNVSIT
+4 ;
UPDATEX ;
+1 KILL DIADD,DLAYGO
+2 DO ^XBFMK
+3 QUIT
GETSORT ;get sort value
+1 IF APCDCSRT="D"
SET APCDSORT=$PIECE(^AUPNVSIT(APCDV,0),U)
QUIT
+2 ;I APCDCSRT="C" S APCDSORT=$$CLINIC^APCLV(APCDV,"C") Q ;clinic code
+3 ;hrn sort values
+4 SET APCDSORT=$$HRN^AUPNPAT($PIECE(^AUPNVSIT(APCDV,0),U,5),DUZ(2))
+5 IF APCDCSRT'="T"
QUIT
+6 SET APCDSORT=APCDSORT+10000000
SET APCDSORT=$EXTRACT(APCDSORT,7,8)_"-"_+$EXTRACT(APCDSORT,2,8)
+7 QUIT
PRINT ;EP - called from XBDBQUE
+1 SET APCDQUIT=""
SET APCDPG=0
DO HDR
+2 IF '$DATA(^XTMP("APCDCAFC",APCDJ,APCDBT))
WRITE !!,"NO VISITS TO REPORT",!
GOTO DONE
+3 SET APCDSORT=""
FOR
SET APCDSORT=$ORDER(^XTMP("APCDCAFC",APCDJ,APCDBT,"VISITS",APCDSORT))
IF APCDSORT=""!(APCDQUIT)
QUIT
Begin DoDot:1
+4 SET APCDV=0
FOR
SET APCDV=$ORDER(^XTMP("APCDCAFC",APCDJ,APCDBT,"VISITS",APCDSORT,APCDV))
IF APCDV'=+APCDV!(APCDQUIT)
QUIT
Begin DoDot:2
+5 IF $Y>(IOSL-4)
DO HDR
IF APCDQUIT
QUIT
+6 SET APCDVR=^AUPNVSIT(APCDV,0)
+7 ;Y2000
WRITE !,$EXTRACT($PIECE(^DPT($PIECE(APCDVR,U,5),0),U),1,15),?16,$$HRN^AUPNPAT($PIECE(APCDVR,U,5),DUZ(2)),?24,$$DATE($PIECE($PIECE(APCDVR,U),".")),?36,$PIECE(APCDVR,U,7),?39,$$CLINIC^APCLV(APCDV,"C")
+8 SET APCDC=0
SET APCDY=0
FOR
SET APCDY=$ORDER(^AUPNVPOV("AD",APCDV,APCDY))
IF APCDY'=+APCDY!(APCDQUIT)
QUIT
Begin DoDot:3
+9 SET APCDC=APCDC+1
+10 IF $Y>(IOSL-3)
DO HDR
IF APCDQUIT
QUIT
+11 IF APCDC>1
WRITE !
+12 WRITE ?45,$$VAL^XBDIQ1(9000010.07,APCDY,.01)
End DoDot:3
End DoDot:2
+13 QUIT
End DoDot:1
DONE ;
+1 KILL ^XTMP("APCDCAFC",APCDJ,APCDBT),APCDJ,APCDBT
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="EO"
SET DIR("A")="End of report. PRESS ENTER"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(IOF)
WRITE @IOF
+4 QUIT
DE ;EP;FIND DEP ENTRIES
+1 KILL APCDX,APCDD
SET APCDC=0
+2 SET APCDVFLE=9000010
FOR
SET APCDVFLE=$ORDER(^DIC(APCDVFLE))
IF APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE)
QUIT
DO DE2
+3 QUIT
+4 ;
DE2 ;
+1 IF '$$DF(APCDVFLE)
QUIT
+2 SET APCDVDG=^DIC(APCDVFLE,0,"GL")
SET APCDVIGR=APCDVDG_"""AD"",APCDV,APCDVDFN)"
+3 SET APCDVDFN=""
IF $ORDER(@APCDVIGR)]""
SET APCDC=APCDC+1
SET APCDX(APCDC)=$EXTRACT($PIECE($PIECE(^DIC(APCDVFLE,0),U),"V ",2),1,3)_"'s"
SET Y=$ORDER(@APCDVIGR)
SET $PIECE(APCDX(APCDC),U,3)=$$VALI^XBDIQ1(APCDVFLE,Y,1211)
SET $PIECE(APCDX(APCDC),U,2)=$$VAL^XBDIQ1(APCDVFLE,Y,1202)
+4 QUIT
+5 ;
DATE(D) ;
+1 IF D=""
QUIT ""
+2 QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_(1700+$EXTRACT(D,1,3))
DF(F) ;
+1 IF F=9000010.09
QUIT 1
+2 IF F=9000010.14
QUIT 1
+3 IF F=9000010.22
QUIT 1
+4 IF F=9000010.25
QUIT 1
+5 IF F=9000010.31
QUIT 1
+6 QUIT 0
HDR ;header for report
+1 IF 'APCDPG
GOTO HDR1
+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 APCDQUIT=1
QUIT
HDR1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET APCDPG=APCDPG+1
+2 WRITE $PIECE(^VA(200,DUZ,0),U,2),$$CTR($$FMTE^XLFDT(DT)),?71,"Page ",APCDPG,!
+3 WRITE $$CTR($$LOC),!
+4 WRITE $$CTR("Visits Automatically Completed/Reviewed for Clinic: "_$PIECE(^DIC(40.7,APCDCLIN,0),U)),!
+5 WRITE !?3,"PATIENT NAME",?17,"HRN",?24,"VISIT DATE",?36,"SC",?39,"CL",?45,"Purpose of Visits",!
+6 WRITE $TRANSLATE($JUSTIFY(" ",80)," ","-"),!
+7 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 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
INFORM ;let user know what is gong on
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !!,$$CTR($$LOC,80)
+3 WRITE !,$$CTR($$USR,80),!!
+4 FOR I=1:1
SET X=$PIECE($TEXT(INTRO+I),";;",2)
IF X="END"
QUIT
WRITE !,X
+5 KILL I,X
+6 QUIT
INTRO ;;
+1 ;;This option is used to automatically mark as REVIEWED/COMPLETE all
+2 ;;visits to a particular clinic in a date range that you select.
+3 ;;
+4 ;;***** Please be very careful when using this option. *****
+5 ;;
+6 ;;The visits to the clinic you select must meet the following
+7 ;;criteria:
+8 ;; - Have valid (non .9999/ZZZ.999) POVs
+9 ;; - Have a primary provider
+10 ;; - Match the clinic code you select
+11 ;;
+12 ;;A list of visits that were marked as reviewed/complete
+13 ;;will be provided.
+14 ;;
+15 ;;END
