source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRHDR.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1LRHDR ;DALOI/CJS/RLM-HEALTH DEPARTMENT REPORT ;2/19/91 10:37
2 ;;5.2;LAB SERVICE;**272**;Sep 27, 1994
3 ; Reference to ^%DT supported by DBIA #10003
4 ; Reference to ^%ZIS supported by DBIA #10086
5 ; Reference to ^%ZISC supported by DBIA #10089
6 ; Reference to ^%ZTLOAD supported by DBIA #10063
7 ; Reference to ADD^VADPT supported by DBIA #10061
8 ; Reference to KVAR^VADPT supported by DBIA #10061
9 ; Reference to $$FMTE^XLFDT supported by IA #10103
10 ; Reference to $$NOW^XLFDT supported by IA #10103
11 ; Reference to EN^DIQ supported by DBIA #10004
12BEGIN D DATE
13END D ^%ZISC K DA,IO("Q"),DFN,DR,I,LRDPF,POP,LRDT,LRIDT,ZTSK,LRDFN,LRBUG,LRACC,PNM,SSN,DOB,SEX,LRIO,LRTIME,LRPGM,ZTRTN,ZTIO,ZTDESC,ZTSAVE
14 Q
15DATE S %DT="AE" D ^%DT Q:Y<1 S LRDT=Y K %DT
16 K DIC S %ZIS="Q" D ^%ZIS Q:POP K %ZIS
17 I $D(IO("Q")) S ZTRTN="DQ^LRHDR",ZTIO=ION,ZTSAVE("LRDT")="",ZTDESC="HEALTH DEPARTMENT REPORT" D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED" Q
18 U IO D DISPLAY
19 Q
20DQ S:$D(ZTQUEUED) ZTREQ="@" U IO
21DISPLAY S DIC="^DPT(",DR=.11 S LRBUG=0 F I=0:0 S LRBUG=$O(^LR("AD",LRDT,LRBUG)) Q:LRBUG<1 D LIST
22 Q
23LIST W !!!,?5,$P(^LAB(61.2,LRBUG,0),"^",1),! S LRACC="" F I=0:0 S LRACC=$O(^LR("AD",LRDT,LRBUG,LRACC)) Q:LRACC="" S LRDFN=^(LRACC) D PATIENT
24 Q
25PATIENT S VA200="",LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX S:LRDPA=2 DOB=$P(VADM(3),U,2) I LRDPF'=2 S Y=DOB D DD^LRX
26 W !,PNM,?25," ",SSN,?39," ",Y,?55," ",SEX," ",$$FMTE^XLFDT($$NOW^XLFDT,"")
27 I LRDPF=2 D
28 . N I,X,Y,N D ADD^VADPT
29 W:$L($G(VAPA(8))) !,"PHONE: ",VAPA(8) S DA=DFN D EN^DIQ
30 D KVAR^VADPT
31 Q
Note: See TracBrowser for help on using the repository browser.