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

APCDCAFC.m

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