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

APCDCAFB.m

Go to the documentation of this file. 
  1. APCDCAFB ; IHS/CMI/LAB - ; 
  1.  ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
  1.  ;
  1. START ;
  1.  D XIT
  1.  I '$D(IOF) D HOME^%ZIS
  1.  D TERM^VALM0
  1.  W @(IOF),!!
  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 XIT Q
  1.  .W !!,"Please see your Clinical Coordinator or PCC Manager."
  1.  .S DIR(0)="E",DIR("A")="Press Enter" KILL DA D ^DIR KILL DIR
  1.  .Q
  1. DATES K APCDED,APCDBD
  1.  K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning REVIEW Date"
  1.  D ^DIR G:Y<1 XIT S APCDBD=Y
  1.  I APCDBD<$P($G(^APCCCTRL(DUZ(2),0)),U,12) D  G DATES
  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.  K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending REVIEW Date"
  1.  D ^DIR G:Y<1 XIT  S APCDED=Y
  1.  ;
  1.  I APCDED<APCDBD D  G DATES
  1.  . W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
  1.  ;
  1. USER ;
  1.  S APCDDEO=""
  1.  S DIR(0)="YO",DIR("A")="Report on ALL Operators",DIR("?")="If you wish to include visits reviewd by ALL Operators answer Yes.  If you wish to tabulate for only one operator enter NO." D ^DIR K DIR
  1.  G:$D(DIRUT) DATES
  1.  I Y=1 S APCDDEO="" G SUB
  1. DEC1 ;enter location
  1.  S DIC("A")="Which Operator: ",DIC="^VA(200,",DIC(0)="AEMQ" D ^DIC K DIC,DA G:Y<0 USER
  1.  S APCDDEO=+Y
  1. SUB ;
  1.  S APCDVSTD=""
  1.  K DIR W ! S DIR(0)="Y",DIR("A")="Do you wish to see a subtotal by REVIEW Date",DIR("B")="Y" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G USER
  1.  S APCDVSTD=Y
  1. ZIS ;call xbdbque
  1.  S XBRC="DRIVER^APCDCAFB",XBRP="PRINT^APCDCAFB",XBRX="XIT^APCDCAFB",XBNS="APCD"
  1.  D ^XBDBQUE
  1.  D XIT
  1.  Q
  1. DRIVER ;EP entry point for taskman
  1.  S APCDBT=$H,APCDJOB=$J
  1.  K ^XTMP("APCDCAFB",APCDJOB,APCDBT)
  1.  S ^XTMP("APCDCAFB",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"CODING QUEUE TALLY"
  1.  ;loop through all visits in date range and exclude any not reviewed in the date range
  1.  D V
  1.  S APCDET=$H
  1.  Q
  1. V ;
  1.  S APCDODAT=$P(APCDBD,".")-1,APCDODAT=APCDODAT_".9999"
  1.  S (APCDRCNT,APCDVCAI)=0 F  S APCDODAT=$O(^AUPNVCA("B",APCDODAT)) Q:APCDODAT=""!($P(APCDODAT,".")>$P(APCDED,"."))  D
  1.  .S APCDVCAI=0 F  S APCDVCAI=$O(^AUPNVCA("B",APCDODAT,APCDVCAI)) Q:APCDVCAI'=+APCDVCAI  D
  1.  ..S APCDVIEN=$P(^AUPNVCA(APCDVCAI,0),U,3)
  1.  ..Q:'APCDVIEN
  1.  ..Q:'$D(^AUPNVSIT(APCDVIEN,0))
  1.  ..S APCDV0=$G(^AUPNVSIT(APCDVIEN,0))
  1.  ..Q:APCDV0=""
  1.  ..Q:$P($G(^AUPNVSIT(APCDVIEN,11)),U,11)=""  ;not reviewed yet
  1.  ..S APCDU=$P($G(^AUPNVCA(APCDVCAI,0)),U,5)
  1.  ..Q:APCDU=""
  1.  ..I $G(APCDDEO),APCDU'=APCDDEO Q  ;want 1 operator and this isn't it
  1.  ..D SET(APCDU,$P($P(^AUPNVCA(APCDVCAI,0),U),"."),1)
  1.  ..I $P(^AUPNVCA(APCDVCAI,0),U,4)="R" D SET(APCDU,$P($P(^AUPNVCA(APCDVCAI,0),U),"."),2)
  1.  S APCDET=$H
  1.  Q
  1. SET(R,D,P) ;
  1.  S $P(^XTMP("APCDCAFB",APCDJOB,APCDBT,R,D),U,P)=$P($G(^XTMP("APCDCAFB",APCDJOB,APCDBT,R,D)),U,P)+1
  1.  S $P(^XTMP("APCDCAFB",APCDJOB,APCDBT,R),U,P)=$P($G(^XTMP("APCDCAFB",APCDJOB,APCDBT,R)),U,P)+1
  1.  Q
  1. PRINT ;EP
  1.  S APCDQUIT="",APCDPG=0,APCDTOTV=0,APCDTOTR=0 D HDR
  1.  I '$D(^XTMP("APCDCAFB",APCDJOB,APCDBT)) D HDR W !!,"NO DATA TO REPORT",! G DONE
  1.  S APCDU="" F  S APCDU=$O(^XTMP("APCDCAFB",APCDJOB,APCDBT,APCDU)) Q:APCDU=""!(APCDQUIT)  D
  1.  . I $Y>(IOSL-3) D HDR Q:APCDQUIT
  1.  . W !!,$P(^VA(200,APCDU,0),U),?40,$$C($P(^XTMP("APCDCAFB",APCDJOB,APCDBT,APCDU),U),0),?55,$$C($P(^XTMP("APCDCAFB",APCDJOB,APCDBT,APCDU),U,2),0)
  1.  . S APCDTOTV=APCDTOTV+$P(^XTMP("APCDCAFB",APCDJOB,APCDBT,APCDU),U,1),APCDTOTR=APCDTOTR+$P(^XTMP("APCDCAFB",APCDJOB,APCDBT,APCDU),U,2)
  1.  . Q:'APCDVSTD
  1.  . S APCDD=0 F  S APCDD=$O(^XTMP("APCDCAFB",APCDJOB,APCDBT,APCDU,APCDD)) Q:APCDD'=+APCDD!(APCDQUIT)  D
  1.  .. I $Y>(IOSL-3) D HDR Q:APCDQUIT
  1.  .. W !?10,$$FMTE^XLFDT(APCDD),?40,$$C($P(^XTMP("APCDCAFB",APCDJOB,APCDBT,APCDU,APCDD),U),0),?55,$$C($P(^XTMP("APCDCAFB",APCDJOB,APCDBT,APCDU,APCDD),U,2),0)
  1.  .Q
  1.  I APCDQUIT G DONE
  1.  I $Y>(IOSL-3) D HDR G:APCDQUIT DONE
  1.  W !!,"Total Number of Visits:  ",?40,$$C(APCDTOTV,0),?55,$$C(APCDTOTR,0),!
  1. DONE ;
  1.  K ^XTMP("APCDCAFB",APCDJOB,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. C(X,X2,X3) ;
  1.  D COMMA^%DTC
  1.  Q $$STRIP^XLFSTR(X," ")
  1. HDR ;EP;HEADER
  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 !,$$FMTE^XLFDT(DT),?70,"Page: ",APCDPG
  1.  W !?29,"PCC Data Entry Module"
  1.  W !,$$CTR("******************************************************",80)
  1.  W !,$$CTR("*   COUNT OF VISITS REVIEWED/COMPLETED BY OPERATOR   *",80)
  1.  W !,$$CTR("******************************************************",80)
  1.  S X="REVIEW Date Range: "_$$FMTE^XLFDT(APCDBD)_" through "_$$FMTE^XLFDT(APCDED) W !,$$CTR(X,80)
  1.  ;I APCDLOCT="A" S X="Location of Encounter: All" W !,$$CTR(X,80)
  1.  ;I APCDLOCT'="A" D
  1.  ;.S X=0,Y="" F  S X=$O(APCDLOCS(X)) Q:X'=+X  S Y=Y_$S(Y="":"",1:";")_$P(^AUTTLOC(X,0),U,2)
  1.  ;.;S X="Locations: "_Y W !,$$CTR(Y,80)
  1.  W !!,"Operator",?40,"# of visits",?55,"# of visits marked"
  1.  W !?40,"reviewed",?55,"as complete"
  1.  W !,$$REPEAT^XLFSTR("-",80)
  1.  Q
  1. OPER(V) ;
  1.  I '$D(^AUPNVSIT(V,0)) Q ""
  1.  I '$D(^AUPNVCA("AD",V)) Q ""
  1.  NEW X,G
  1.  S G=""
  1.  S X=0 F  S X=$O(^AUPNVCA("AD",V,X)) Q:X'=+X!(G)  D
  1.  .Q:'$D(^AUPNVCA(X,0))
  1.  .I $P(^AUPNVCA(X,0),U,4)="R" S G=$P(^AUPNVCA(X,0),U,5)_U_$P($P(^AUPNVCA(X,0),U),".") Q
  1.  .Q
  1.  Q G
  1.  ;
  1. XIT ;
  1.  K DIR
  1.  D EN^XBVK("APCD")  ;clean up APCD variables
  1.  D ^XBFMK  ;clean up fileman variables
  1.  D KILL^AUPNPAT  ;clean up AUPN
  1.  D EN^XBVK("AMQQ")  ;clean up after qman
  1.  Q
  1.  ;
  1. D(D) ;
  1.  I $G(D)="" Q ""
  1.  Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
  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. EOP ;EP - End of page.
  1.  Q:$E(IOST)'="C"
  1.  Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
  1.  NEW DIR
  1.  K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  S DIR("A")="End of report.  Press Enter",DIR(0)="E" D ^DIR
  1.  Q
  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 ;inform user what this report is all about
  1.  W !,$$CTR($$LOC)
  1.  W !!,$$CTR("PCC/EHR CODING AUDIT")
  1.  W !!,"This report will produce a tally of visits REVIEWED/COMPLETED"
  1.  W !,"by the user who reviewed/completed the visit.  PLEASE NOTE:  this"
  1.  W !,"report will only look at visits that have been reviewed and"
  1.  W !,"marked as either REVIEWED/COMPLETE or INCOMPLETE.  If a visit has"
  1.  W !,"never been reviewed it is not counted in this report.  You must"
  1.  W !,"enter the REVIEW date range.  This is the date range for which visits"
  1.  W !,"were reviewed.",!!
  1.  W !,"Please keep in mind that more than one operator may have reviewed"
  1.  W !,"a visit so the total number of visits in this report may be more"
  1.  W !,"than the total number of visits to the facility as one visit"
  1.  W !,"may be counted more than once."
  1.  W !
  1.  Q
  1. OLOC ;one location
  1.  S DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("A")="Which LOCATION: " D ^DIC K DIC
  1.  I Y=-1 S APCDQ="" Q
  1.  S APCDLOCS(+Y)=""
  1.  Q
  1. SLOC ;taxonomy of locations
  1.  S X="LOCATION OF ENCOUNTER",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" G XIT
  1.  D PEP^AMQQGTX0(+Y,"APCDLOCS(")
  1.  I '$D(APCDLOCS) S APCDQ="" Q
  1.  I $D(APCDLOCS("*")) S APCDLOCT="A" K APCDLOCS W !!,"**** all locations will be included ****",! Q
  1.  Q
  1. INSTALLD(APCDSTAL) ;EP - Determine if patch APCDSTAL was installed, where
  1.  ; APCDSTAL is the name of the INSTALL.  E.g "AG*6.0*11".
  1.  ;
  1.  NEW APCDY,DIC,X,Y
  1.  S X=$P(APCDSTAL,"*",1)
  1.  S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
  1.  D IX^DIC
  1.  I Y<1 D IMES Q 0
  1.  S DIC=DIC_+Y_",22,",X=$P(APCDSTAL,"*",2)
  1.  D ^DIC
  1.  I Y<1 D IMES Q 0
  1.  S DIC=DIC_+Y_",""PAH"",",X=$P(APCDSTAL,"*",3)
  1.  D ^DIC
  1.  S APCDY=Y
  1.  D IMES
  1.  Q $S(APCDY<1:0,1:1)
  1. IMES ;
  1.  D MES^XPDUTL($$CJ^XLFSTR("Patch """_APCDSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
  1.  Q
  1. INSTDATE(APCDSTAL) ;EP - Determine if patch APCDSTAL was installed, where
  1.  ; APCDSTAL is the name of the INSTALL.  E.g "AG*6.0*11".
  1.  ;
  1.  NEW APCDY,DIC,X,Y,APCDX,APCDZ
  1.  S X=$P(APCDSTAL,"*",1)
  1.  S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
  1.  D IX^DIC
  1.  S APCDX=+Y
  1.  S DIC=DIC_APCDX_",22,",X=$P(APCDSTAL,"*",2)
  1.  D ^DIC
  1.  S APCDZ=+Y
  1.  S DIC=DIC_APCDZ_",""PAH"",",X=$P(APCDSTAL,"*",3)
  1.  D ^DIC
  1.  S APCDY=+Y
  1.  Q $$FMTE^XLFDT($P(^DIC(9.4,APCDX,22,APCDZ,"PAH",APCDY,0),U,2))