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

APCDKLVR.m

Go to the documentation of this file.
  1. APCDKLVR ; IHS/CMI/LAB - PCC DATA ENTRY ORPHAN LAB PRINT ;
  1. ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1. ;
  1. W:$D(IOF) @IOF
  1. W !,"****** PCC DATA DATA ENTRY REPORT OF COMPLETED 'ORPHAN' LAB/RADIOLOGY/PHARMACY",!,"VISITS ******",!
  1. W !!,"This report will list all visits that were completed using the option",!,"to complete orphaned lab or radiology or pharmacy visits.",!!
  1. TYPE ;
  1. S APCDRTYP=""
  1. S DIR(0)="S^L:Lab Visits;R:Radiology Visits;P:Pharmacy Visits;I:Immunization;B:Blood Bank;M:Microbiology;A:All Completed Visits",DIR("A")="Which type of Completed Visits to you wish to list",DIR("B")="A" KILL DA D ^DIR KILL DIR
  1. I $D(DIRUT) D XIT Q
  1. S APCDRTYP=Y
  1. GETDATES ;
  1. W !,"Please enter the date range for which you would like to see",!,"a list of completed ",$$V(APCDRTYP)," visits.",!
  1. BD ;get beginning date
  1. W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning date for the report " 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)="DA^"_APCDBD_":DT:EP",DIR("A")="Enter ending date for the report: " 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. S X1=APCDBD,X2=-1 D C^%DTC S APCDSD=X
  1. ;
  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. S XBRC="PROCESS^APCDKLVR",XBRP="PROCPRN^APCDKLVR",XBRX="XIT^APCDKLVR",XBNS="APCD"
  1. D ^XBDBQUE
  1. D XIT
  1. Q
  1. BROWSE ;
  1. S XBRP="VIEWR^XBLM(""PROCPRN^APCDKLVR"")"
  1. S XBNS="APCD",XBRC="PROCESS^APCDKLVR",XBRX="XIT^APCDKLVR",XBIOP=0 D ^XBDBQUE
  1. Q
  1. ;
  1. PROCESS ; Entry point for Taskman
  1. S APCDJOB=$J,APCDBTH=$H
  1. K ^XTMP("APCDKLVR",APCDJOB,APCDBTH)
  1. S ^XTMP("APCDKLVR",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"PCC DATA ENTRY LAB REPORT"
  1. S APCDD=APCDSD F S APCDD=$O(^APCDLLOG("AC",APCDD)) Q:APCDD=""!(APCDD>APCDED) D
  1. .S APCDV=0 F S APCDV=$O(^APCDLLOG("AC",APCDD,APCDV)) Q:APCDV'=+APCDV D
  1. ..I APCDRTYP="A" S ^XTMP("APCDKLVR",APCDJOB,APCDBTH,"VISITS",APCDD,$P(^APCDLLOG(APCDV,0),U))="" Q
  1. ..I APCDRTYP=$P(^APCDLLOG(APCDV,0),U,3) S ^XTMP("APCDKLVR",APCDJOB,APCDBTH,"VISITS",APCDD,$P(^APCDLLOG(APCDV,0),U))="" Q
  1. Q
  1. PROCPRN ;EP - called from xbdbque to print report
  1. S APCD80E="==============================================================================="
  1. S APCD80D="-------------------------------------------------------------------------------"
  1. S APCDPG=0 D @("HEAD"_(2-($E(IOST,1,2)="C-"))) I '$D(^XTMP("APCDKLVR",APCDJOB,APCDBTH)) W !,"No visits to report",! G DONE
  1. S APCDDATE=0 F S APCDDATE=$O(^XTMP("APCDKLVR",APCDJOB,APCDBTH,"VISITS",APCDDATE)) Q:APCDDATE="" D
  1. .S APCDV=0 K APCDQUIT
  1. .I $Y>(IOSL-4) D HEAD Q:$D(APCDQUIT)
  1. .W !,"Date 'Orphan' Visit Completed: ",$$FMTE^XLFDT(APCDDATE)
  1. .F S APCDV=$O(^XTMP("APCDKLVR",APCDJOB,APCDBTH,"VISITS",APCDDATE,APCDV)) Q:APCDV=""!($D(APCDQUIT)) D PRINT
  1. DONE ;
  1. K ^XTMP("APCDKLVR",APCDJOB,APCDBTH)
  1. I $E(IOST)="C",IO=IO(0) S DIR(0)="E",DIR("A")="End of report. Press return." KILL DA D ^DIR KILL DIR
  1. Q
  1. PRINT ;
  1. I $Y>(IOSL-6) D HEAD Q:$D(APCDQUIT)
  1. S APCDV0=^AUPNVSIT(APCDV,0)
  1. S DFN=$P(APCDV0,U,5),APCDHRN="" S:$D(^AUPNPAT(DFN,41,DUZ(2),0)) APCDHRN=$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2)
  1. PRN ;
  1. S (APCDLAB,X)=0 F S X=$O(^AUPNVLAB("AD",APCDV,X)) Q:X'=+X S APCDLAB=APCDLAB+1
  1. S (APCDRAD,X)=0 F S X=$O(^AUPNVRAD("AD",APCDV,X)) Q:X'=+X S APCDRAD=APCDRAD+1
  1. S (APCDMED,X)=0 F S X=$O(^AUPNVMED("AD",APCDV,X)) Q:X'=+X S APCDMED=APCDMED+1
  1. S (APCDIMM,X)=0 F S X=$O(^AUPNVIMM("AD",APCDV,X)) Q:X'=+X S APCDIMM=APCDIMM+1
  1. S (APCDBB,X)=0 F S X=$O(^AUPNVBB("AD",APCDV,X)) Q:X'=+X S APCDBB=APCDBB+1
  1. S (APCDMIC,X)=0 F S X=$O(^AUPNVMIC("AD",APCDV,X)) Q:X'=+X S APCDMIC=APCDMIC+1
  1. W !,$$VDTM^APCLV(APCDV,"E"),?19,APCDHRN,?26,$E($$LOCENC^APCLV(APCDV,"E"),1,10),?38,$$TYPE^APCLV(APCDV,"I"),?43,$$SC^APCLV(APCDV,"I")
  1. W ?46,$$T(APCDV),?54,$S($$T(APCDV)="LAB":APCDLAB,$$T(APCDV)="MED":APCDMED,$$T(APCDV)="RAD":APCDRAD,$$T(APCDV)="IMM":APCDIMM,$$T(APCDV)="BB":APCDBB,$$T(APCDV)="MIC":"MICROBIOLOGY",1:""),?61,$$VAL^XBDIQ1(9000010,APCDV,.28)
  1. Q
  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="" Q
  1. HEAD1 ;
  1. W:$D(IOF) @IOF
  1. HEAD2 ;
  1. 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),?72,"Page ",APCDPG,!
  1. W ?10,"ANCILLARY VISITS FOR WHICH A PROVIDER AND POV WERE APPENDED",!
  1. W ?20,"Dates range: ",$$FMTE^XLFDT(APCDBD),"-",$$FMTE^XLFDT(APCDED),!
  1. W !,"VISIT DATE/TIME",?20,"HRN",?26,"LOCATION",?37,"TYPE",?43,"SC",?52,"# ",$$V1(APCDRTYP),?61,"BILLING LINK DATE"
  1. W !,APCD80D
  1. Q
  1. XIT ;
  1. K DA,DIE,DIC,DIR,DFN
  1. K APCD80E,APCD80D,APCDJOB,APCDV0,APCDBTH,APCDBD,APCDD,APCDDATE,APCDED,APCDHRN,APCDLAB,APCDPG,APCDSD,APCDV
  1. Q
  1. ;
  1. T(V) ;
  1. I '$G(V) Q ""
  1. I $D(^AUPNVLAB("AD",APCDV)) Q "LAB"
  1. I $D(^AUPNVRAD("AD",APCDV)) Q "RAD"
  1. I $D(^AUPNVMED("AD",APCDV)) Q "MED"
  1. I $D(^AUPNVIMM("AD",APCDV)) Q "IMM"
  1. I $D(^AUPNVBB("AD",APCDV)) Q "BB"
  1. I $D(^AUPNVMIC("AD",APCDV)) Q "MIC"
  1. Q "??"
  1. V1(R) ;
  1. I R="R" Q "RADS"
  1. I R="L" Q "LABS"
  1. I R="P" Q "MEDS"
  1. I R="A" Q "ENT"
  1. I R="I" Q "IMM"
  1. I R="B" Q "BB"
  1. I R="M" Q "MIC"
  1. Q ""
  1. V(R) ;
  1. I R="R" Q "RADIOLOGY"
  1. I R="L" Q "LAB"
  1. I R="P" Q "PHARMACY"
  1. I R="I" Q "IMMUNIZATION"
  1. I R="A" Q "LAB/RAD/RX/IMM/BB/MICRO"
  1. I R="B" Q "BLOOD BANK"
  1. I R="M" Q "MICROBIOLOGY"
  1. Q ""