LRHDR ;DALOI/CJS/RLM-HEALTH DEPARTMENT REPORT ;2/19/91 10:37
;;5.2;LAB SERVICE;**272**;Sep 27, 1994
; Reference to ^%DT supported by DBIA #10003
; Reference to ^%ZIS supported by DBIA #10086
; Reference to ^%ZISC supported by DBIA #10089
; Reference to ^%ZTLOAD supported by DBIA #10063
; Reference to ADD^VADPT supported by DBIA #10061
; Reference to KVAR^VADPT supported by DBIA #10061
; Reference to $$FMTE^XLFDT supported by IA #10103
; Reference to $$NOW^XLFDT supported by IA #10103
; Reference to EN^DIQ supported by DBIA #10004
BEGIN D DATE
END 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
Q
DATE S %DT="AE" D ^%DT Q:Y<1 S LRDT=Y K %DT
K DIC S %ZIS="Q" D ^%ZIS Q:POP K %ZIS
I $D(IO("Q")) S ZTRTN="DQ^LRHDR",ZTIO=ION,ZTSAVE("LRDT")="",ZTDESC="HEALTH DEPARTMENT REPORT" D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED" Q
U IO D DISPLAY
Q
DQ S:$D(ZTQUEUED) ZTREQ="@" U IO
DISPLAY S DIC="^DPT(",DR=.11 S LRBUG=0 F I=0:0 S LRBUG=$O(^LR("AD",LRDT,LRBUG)) Q:LRBUG<1 D LIST
Q
LIST 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
Q
PATIENT 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
W !,PNM,?25," ",SSN,?39," ",Y,?55," ",SEX," ",$$FMTE^XLFDT($$NOW^XLFDT,"")
I LRDPF=2 D
. N I,X,Y,N D ADD^VADPT
W:$L($G(VAPA(8))) !,"PHONE: ",VAPA(8) S DA=DFN D EN^DIQ
D KVAR^VADPT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRHDR 1570 printed Oct 16, 2024@18:15:50 Page 2
LRHDR ;DALOI/CJS/RLM-HEALTH DEPARTMENT REPORT ;2/19/91 10:37
+1 ;;5.2;LAB SERVICE;**272**;Sep 27, 1994
+2 ; Reference to ^%DT supported by DBIA #10003
+3 ; Reference to ^%ZIS supported by DBIA #10086
+4 ; Reference to ^%ZISC supported by DBIA #10089
+5 ; Reference to ^%ZTLOAD supported by DBIA #10063
+6 ; Reference to ADD^VADPT supported by DBIA #10061
+7 ; Reference to KVAR^VADPT supported by DBIA #10061
+8 ; Reference to $$FMTE^XLFDT supported by IA #10103
+9 ; Reference to $$NOW^XLFDT supported by IA #10103
+10 ; Reference to EN^DIQ supported by DBIA #10004
BEGIN DO DATE
END DO ^%ZISC
KILL 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
+1 QUIT
DATE SET %DT="AE"
DO ^%DT
if Y<1
QUIT
SET LRDT=Y
KILL %DT
+1 KILL DIC
SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
KILL %ZIS
+2 IF $DATA(IO("Q"))
SET ZTRTN="DQ^LRHDR"
SET ZTIO=ION
SET ZTSAVE("LRDT")=""
SET ZTDESC="HEALTH DEPARTMENT REPORT"
DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"REQUEST QUEUED"
QUIT
+3 USE IO
DO DISPLAY
+4 QUIT
DQ if $DATA(ZTQUEUED)
SET ZTREQ="@"
USE IO
DISPLAY SET DIC="^DPT("
SET DR=.11
SET LRBUG=0
FOR I=0:0
SET LRBUG=$ORDER(^LR("AD",LRDT,LRBUG))
if LRBUG<1
QUIT
DO LIST
+1 QUIT
LIST WRITE !!!,?5,$PIECE(^LAB(61.2,LRBUG,0),"^",1),!
SET LRACC=""
FOR I=0:0
SET LRACC=$ORDER(^LR("AD",LRDT,LRBUG,LRACC))
if LRACC=""
QUIT
SET LRDFN=^(LRACC)
DO PATIENT
+1 QUIT
PATIENT SET VA200=""
SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
SET DFN=$PIECE(^(0),U,3)
DO PT^LRX
if LRDPA=2
SET DOB=$PIECE(VADM(3),U,2)
IF LRDPF'=2
SET Y=DOB
DO DD^LRX
+1 WRITE !,PNM,?25," ",SSN,?39," ",Y,?55," ",SEX," ",$$FMTE^XLFDT($$NOW^XLFDT,"")
+2 IF LRDPF=2
Begin DoDot:1
+3 NEW I,X,Y,N
DO ADD^VADPT
End DoDot:1
+4 if $LENGTH($GET(VAPA(8)))
WRITE !,"PHONE: ",VAPA(8)
SET DA=DFN
DO EN^DIQ
+5 DO KVAR^VADPT
+6 QUIT
