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

APCLOR1.m

Go to the documentation of this file. 
  1. APCLOR1 ; IHS/CMI/LAB - ;
  1.  ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1.  ;
  1. START ;
  1.  D XIT
  1.  I '$D(IOF) D HOME^%ZIS
  1.  W @(IOF),!!
  1.  D INFORM
  1. TYPE ;type of report
  1.  S APCLRTYP=""
  1.  S DIR(0)="S^L:LAB;P:PHARMACY;R:RADIOLOGY",DIR("A")="What type of ophan visits should be included" KILL DA D ^DIR KILL DIR
  1.  G:$D(DIRUT) XIT
  1.  S APCLRTYP=Y,APCLRTYE=Y(0)
  1. DATES K APCLED,APCLBD
  1.  K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Visit Date"
  1.  D ^DIR G:Y<1 TYPE S APCLBD=Y
  1.  K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Visit Date"
  1.  D ^DIR G:Y<1 TYPE  S APCLED=Y
  1.  ;
  1.  I APCLED<APCLBD D  G DATES
  1.  . W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
  1.  S APCLSD=$$FMADD^XLFDT(APCLBD,-1)_".9999"
  1.  ;
  1. FAC ;
  1.  S APCLLOCT=""
  1.  S DIR(0)="S^A:ALL Locations/Facilities;S:One SERVICE UNIT'S Locations/Facilities;O:ONE Location/Facility",DIR("A")="Include Visits to Which Location/Facilities",DIR("B")="A"
  1.  S DIR("A")="Enter a code indicating what LOCATIONS/FACILITIES are of interest",DIR("B")="O" K DA D ^DIR K DIR,DA
  1.  G:$D(DIRUT) DATES
  1.  S APCLLOCT=Y
  1.  I APCLLOCT="A" G ZIS
  1.  D @APCLLOCT
  1.  G:$D(APCLQ) FAC
  1. ZIS ;
  1. DEMO ;
  1.  D DEMOCHK^APCLUTL(.APCLDEMO)
  1.  I APCLDEMO=-1 G FAC
  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="PROC^APCLOR1",XBRP="PRINT^APCLOR1",XBNS="APCL",XBRX="XIT^APCLOR1"
  1.  D ^XBDBQUE
  1. XIT ;
  1.  D EN^XBVK("APCL"),^XBFMK
  1.  Q
  1.  ;
  1. BROWSE ;
  1.  S XBRP="VIEWR^XBLM(""PRINT^APCLOR1"")"
  1.  S XBNS="APCL",XBRC="PROC^APCLOR1",XBRX="XIT^APCLOR1",XBIOP=0 D ^XBDBQUE
  1.  Q
  1.  ;
  1. PROC ;EP - called from xbdbque
  1.  S ^XTMP("APCLOR1",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"ORPHANED VISIT REPORT"
  1.  S APCLJ=$J,APCLH=$H,APCLCNT=0
  1.  K ^XTMP("APCLOR1",APCLJ,APCLH)
  1.  ;$O through all visits and set for patient once
  1.  F  S APCLSD=$O(^AUPNVSIT("B",APCLSD)) Q:APCLSD=""!((APCLSD\1)>APCLED)  D
  1.  .S APCLV=0 F  S APCLV=$O(^AUPNVSIT("B",APCLSD,APCLV)) Q:APCLV'=+APCLV  I $D(^AUPNVSIT(APCLV,0)),$P(^(0),U,9),'$P(^(0),U,11) D PROC1
  1.  .Q
  1.  Q
  1. PROC1 ;
  1.  I $P(^AUPNVSIT(APCLV,0),U,6)="" Q
  1.  I $P(^AUPNVSIT(APCLV,0),U,5)="" Q
  1.  Q:$$DEMO^APCLUTL($P(^AUPNVSIT(APCLV,0),U,5),$G(APCLDEMO))
  1.  I $P(^AUPNVSIT(APCLV,0),U,7)="E" Q  ;exclude events
  1.  I $D(^AUPNVPOV("AD",APCLV)),$D(^AUPNVPRV("AD",APCLV)) Q  ;coded, not orphaned
  1.  I $P(^AUPNVSIT(APCLV,0),U,7)="I",$P(^AUPNVSIT(APCLV,0),U,12)]"" Q  ;PER VINA 10-20-04
  1.  I APCLRTYP="L",'$D(^AUPNVLAB("AD",APCLV)) Q
  1.  I APCLRTYP="R",'$D(^AUPNVRAD("AD",APCLV)) Q
  1.  I APCLRTYP="P",'$D(^AUPNVMED("AD",APCLV)) Q
  1.  I APCLLOCT="O",$P(^AUPNVSIT(APCLV,0),U,6)'=APCLLOCT("ONE") Q
  1.  I APCLLOCT="S",$$VALI^XBDIQ1(9999999.06,$P(^AUPNVSIT(APCLV,0),U,6),.05)'=APCLLOCT("SU") Q
  1.  S ^XTMP("APCLOR1",APCLJ,APCLH,"VISITS",APCLV)="",APCLCNT=APCLCNT+1
  1.  Q
  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 !!,"This report will list all visits that are 'orphan visits'.  You will be asked",!,"to select whether you want orpaned lab, pharmacy or radiology visits."
  1.  W !,"If you select lab, you will get all visits with no primary provider or",!,"pov entered that have a lab entry attached to them.  The same is true for",!,"pharmacy or radiology.",!
  1.  W !!,"If a visit has both a V LAB and a V RADIOLOGY the visit would be included",!,"in each report.",!!
  1.  Q
  1. O ;one location
  1.  S DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("A")="Which LOCATION: " D ^DIC K DIC
  1.  I Y=-1 S APCLQ="" Q
  1.  S APCLLOCT("ONE")=+Y
  1.  Q
  1. S ;all communities within APCLSU su
  1.  S DIC="^AUTTSU(",DIC("B")=$$VAL^XBDIQ1(9999999.06,DUZ(2),.05),DIC(0)="AEMQ",DIC("A")="Which SERVICE UNIT: " D ^DIC K DIC
  1.  I Y=-1 S APCLQ="" Q
  1.  S APCLLOCT("SU")=+Y
  1.  Q
  1.  ;
  1. PRINT ;EP - called from xbdbque
  1.  K APCLQ S APCLPG=0 D HEADER
  1.  I '$D(^XTMP("APCLOR1",APCLJ,APCLH)) D HEADER W !!,"NO DATA TO REPORT",! G DONE
  1.  W !!,"TOTAL NUMBER OF VISITS FOUND: ",APCLCNT,!!
  1.  S APCLV=0 F  S APCLV=$O(^XTMP("APCLOR1",APCLJ,APCLH,"VISITS",APCLV)) Q:APCLV'=+APCLV!($D(APCLQ))  D
  1.  .I $Y>(IOSL-3) D HEADER Q:$D(APCLQ)
  1.  .S APCLVREC=^AUPNVSIT(APCLV,0)
  1.  .W !,$$HRN^AUPNPAT($P(APCLVREC,U,5),DUZ(2),2),?12,$E($P(^DPT($P(APCLVREC,U,5),0),U),1,20),?35,$$FMTE^XLFDT($P($P(APCLVREC,U),"."))
  1.  .W ?48,$P($$FMTE^XLFDT($P(APCLVREC,U),"2P")," ",2),?55,$P(APCLVREC,U,7),?59,$P(APCLVREC,U,3),?62,$P(^AUTTLOC($P(APCLVREC,U,6),0),U,7),?68,$$NLAB(APCLV),?73,$$NRX(APCLV),?77,$$NRAD(APCLV)
  1. DONE ;
  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.  K APCLTS,APCLS,APCLM,APCLET
  1.  K ^XTMP("APCLOR1",APCLJ,APCLH),APCLJ,APCLH
  1.  Q
  1.  ;
  1. NLAB(V) ;
  1.  NEW X,C
  1.  S (X,C)=0 F  S X=$O(^AUPNVLAB("AD",V,X)) Q:X'=+X  S C=C+1
  1.  Q C
  1. NRX(V) ;
  1.  NEW X,C
  1.  S (X,C)=0 F  S X=$O(^AUPNVMED("AD",V,X)) Q:X'=+X  S C=C+1
  1.  Q C
  1. NRAD(V) ;
  1.  NEW X,C
  1.  S (X,C)=0 F  S X=$O(^AUPNVRAD("AD",V,X)) Q:X'=+X  S C=C+1
  1.  Q C
  1.  G:'APCLPG HEADER1
  1.  K DIR I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQ="" Q
  1. HEADER1 ;
  1.  W:$D(IOF) @IOF S APCLPG=APCLPG+1
  1.  W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCLPG,!
  1.  W !,$$CTR("INCOMPLETE "_APCLRTYE_" VISITS",80),!
  1.  S X="Visit Dates: "_$$FMTE^XLFDT(APCLBD)_" to "_$$FMTE^XLFDT(APCLED) W $$CTR(X,80),!
  1.  W !?68,"#",?72,"#",?76,"#"
  1.  W !,"HRN",?12,"PATIENT NAME",?37,"DATE",?48,"TIME",?54,"SC",?57,"TYPE",?62,"LOC",?67,"LAB",?71,"RX",?75,"RAD"
  1.  W !,$TR($J("",80)," ","-")
  1.  Q