LREPIRP8 ;DALOI/CKA - EPI-PRINT VERIFICATION REPORT ; 5/14/03
;;5.2;LAB SERVICE;**281**;Sep 27, 1994
;PRINT VERIFICATION REPORT CONTINUED
;
;CALLED BY LREPIRP7
Q
PPRT1 ;Print pathogens 1,3,4,5,6,8,10,18,19,20,21,22,23
D HDG^LREPIRP7 W !
S LRNOPAT="",LRNOPAT=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,LRNOPAT))
I LRNOPAT="HDG" W !!,"NO PATIENTS REPORTED FOR THE REPORT PERIOD."
F S LRDFN=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN)) Q:'LRDFN D Q:LRQUIT
.S LRPV1=0,LROBR=0,LROBX=0
.W !!,"PATIENT NAME LAST 4 DOB SEX PERIOD OF SERVICE"
.S LRPID=$G(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PID"))
.W !,LRPID
.F S LRPV1=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1)) Q:'LRPV1 D Q:LRQUIT
..S LROBR=0,LROBX=0
..S LRPV1ND=$G(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1))
..W !,$P(LRPV1ND," "),!,$P(LRPV1ND," ",2)
..I $L($P(LRPV1ND," ",2)) W !
..F S LROBR=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"OBR",LROBR)) Q:'LROBR D Q:LRQUIT
...S LROBX=0
...W !,$G(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"OBR",LROBR))
...F S LROBX=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"OBR",LROBR,"OBX",LROBX)) Q:'LROBX D Q:LRQUIT
....W !,$G(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"OBR",LROBR,"OBX",LROBX))
.I $Y>(IOSL-6) D NPG^LREPIRP7
Q
PPRT2 ;Print pathogens 7,9
D HDG^LREPIRP7 W !
S LRNOPAT="",LRNOPAT=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,LRNOPAT))
I LRNOPAT="HDG" W !!,"NO PATIENTS REPORTED FOR THE REPORT PERIOD."
F S LRDFN=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN)) Q:'LRDFN D Q:LRQUIT
.S LRPV1=0,LROBR=0,LROBX=0
.S LRPID=$G(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PID"))
.W !,LRPID
.F S LRPV1=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1)) Q:'LRPV1 D Q:LRQUIT
..S LROBR=0,LROBX=0,LRDG1=0
..W !,$G(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1))
..F S LRDG1=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"DG1",LRDG1)) Q:'LRDG1 D Q:LRQUIT
...W !,$G(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"DG1",LRDG1))
...F S LROBR=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"OBR",LROBR)) Q:'LROBR D Q:LRQUIT
....S LROBX=0
....W !,$G(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"OBR",LROBR))
....F S LROBX=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"OBR",LROBR,"OBX",LROBX)) Q:'LROBX D Q:LRQUIT
.....W !,$G(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"OBR",LROBR,"OBX",LROBX))
..I $Y>(IOSL-6) D NPG^LREPIRP7
Q
PPRT3 ;Print pathogens 2,15,16,17
D HDG^LREPIRP7 W !
W !!,"Name LAST 4 Accession Date Test Name Test Result"
W !,"____________________________________________________________________"
S LRNOPAT="",LRNOPAT=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,LRNOPAT))
I LRNOPAT="HDG" W !!,"NO PATIENTS REPORTED FOR THE REPORT PERIOD."
S LRDFN=0,LRNUM=0
F S LRDFN=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN)) Q:'LRDFN D Q:LRQUIT S LRNUM=0
.F S LRNUM=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,LRNUM)) Q:'LRNUM D Q:LRQUIT
..W !,^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,LRNUM)
..I $Y>(IOSL-6) D NPG^LREPIRP7
Q
PPRT4 ;Print pathogens 11,12,13,14
D HDG^LREPIRP7 W !
S LRNOPAT="",LRNOPAT=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,LRNOPAT))
I LRNOPAT="HDG" W !!,"NO PATIENTS REPORTED FOR THE REPORT PERIOD."
F S LRDFN=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN)) Q:'LRDFN D Q:LRQUIT
.S LRPV1=0,LRDG1=0
.S LRPID=$G(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PID"))
.W !,LRPID
.F S LRPV1=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1)) Q:'LRPV1 D Q:LRQUIT
..W !,$G(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1))
..S LRDG1=0
..F S LRDG1=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"DG1",LRDG1)) Q:'LRDG1 D Q:LRQUIT
...W !,$G(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"DG1",LRDG1))
.I $Y>(IOSL-6) D NPG^LREPIRP7
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREPIRP8 3911 printed Oct 16, 2024@18:15:15 Page 2
LREPIRP8 ;DALOI/CKA - EPI-PRINT VERIFICATION REPORT ; 5/14/03
+1 ;;5.2;LAB SERVICE;**281**;Sep 27, 1994
+2 ;PRINT VERIFICATION REPORT CONTINUED
+3 ;
+4 ;CALLED BY LREPIRP7
+5 QUIT
PPRT1 ;Print pathogens 1,3,4,5,6,8,10,18,19,20,21,22,23
+1 DO HDG^LREPIRP7
WRITE !
+2 SET LRNOPAT=""
SET LRNOPAT=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,LRNOPAT))
+3 IF LRNOPAT="HDG"
WRITE !!,"NO PATIENTS REPORTED FOR THE REPORT PERIOD."
+4 FOR
SET LRDFN=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN))
if 'LRDFN
QUIT
Begin DoDot:1
+5 SET LRPV1=0
SET LROBR=0
SET LROBX=0
+6 WRITE !!,"PATIENT NAME LAST 4 DOB SEX PERIOD OF SERVICE"
+7 SET LRPID=$GET(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PID"))
+8 WRITE !,LRPID
+9 FOR
SET LRPV1=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1))
if 'LRPV1
QUIT
Begin DoDot:2
+10 SET LROBR=0
SET LROBX=0
+11 SET LRPV1ND=$GET(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1))
+12 WRITE !,$PIECE(LRPV1ND," "),!,$PIECE(LRPV1ND," ",2)
+13 IF $LENGTH($PIECE(LRPV1ND," ",2))
WRITE !
+14 FOR
SET LROBR=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"OBR",LROBR))
if 'LROBR
QUIT
Begin DoDot:3
+15 SET LROBX=0
+16 WRITE !,$GET(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"OBR",LROBR))
+17 FOR
SET LROBX=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"OBR",LROBR,"OBX",LROBX))
if 'LROBX
QUIT
Begin DoDot:4
+18 WRITE !,$GET(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"OBR",LROBR,"OBX",LROBX))
End DoDot:4
if LRQUIT
QUIT
End DoDot:3
if LRQUIT
QUIT
End DoDot:2
if LRQUIT
QUIT
+19 IF $Y>(IOSL-6)
DO NPG^LREPIRP7
End DoDot:1
if LRQUIT
QUIT
+20 QUIT
PPRT2 ;Print pathogens 7,9
+1 DO HDG^LREPIRP7
WRITE !
+2 SET LRNOPAT=""
SET LRNOPAT=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,LRNOPAT))
+3 IF LRNOPAT="HDG"
WRITE !!,"NO PATIENTS REPORTED FOR THE REPORT PERIOD."
+4 FOR
SET LRDFN=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN))
if 'LRDFN
QUIT
Begin DoDot:1
+5 SET LRPV1=0
SET LROBR=0
SET LROBX=0
+6 SET LRPID=$GET(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PID"))
+7 WRITE !,LRPID
+8 FOR
SET LRPV1=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1))
if 'LRPV1
QUIT
Begin DoDot:2
+9 SET LROBR=0
SET LROBX=0
SET LRDG1=0
+10 WRITE !,$GET(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1))
+11 FOR
SET LRDG1=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"DG1",LRDG1))
if 'LRDG1
QUIT
Begin DoDot:3
+12 WRITE !,$GET(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"DG1",LRDG1))
+13 FOR
SET LROBR=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"OBR",LROBR))
if 'LROBR
QUIT
Begin DoDot:4
+14 SET LROBX=0
+15 WRITE !,$GET(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"OBR",LROBR))
+16 FOR
SET LROBX=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"OBR",LROBR,"OBX",LROBX))
if 'LROBX
QUIT
Begin DoDot:5
+17 WRITE !,$GET(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"OBR",LROBR,"OBX",LROBX))
End DoDot:5
if LRQUIT
QUIT
End DoDot:4
if LRQUIT
QUIT
End DoDot:3
if LRQUIT
QUIT
+18 IF $Y>(IOSL-6)
DO NPG^LREPIRP7
End DoDot:2
if LRQUIT
QUIT
End DoDot:1
if LRQUIT
QUIT
+19 QUIT
PPRT3 ;Print pathogens 2,15,16,17
+1 DO HDG^LREPIRP7
WRITE !
+2 WRITE !!,"Name LAST 4 Accession Date Test Name Test Result"
+3 WRITE !,"____________________________________________________________________"
+4 SET LRNOPAT=""
SET LRNOPAT=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,LRNOPAT))
+5 IF LRNOPAT="HDG"
WRITE !!,"NO PATIENTS REPORTED FOR THE REPORT PERIOD."
+6 SET LRDFN=0
SET LRNUM=0
+7 FOR
SET LRDFN=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN))
if 'LRDFN
QUIT
Begin DoDot:1
+8 FOR
SET LRNUM=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,LRNUM))
if 'LRNUM
QUIT
Begin DoDot:2
+9 WRITE !,^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,LRNUM)
+10 IF $Y>(IOSL-6)
DO NPG^LREPIRP7
End DoDot:2
if LRQUIT
QUIT
End DoDot:1
if LRQUIT
QUIT
SET LRNUM=0
+11 QUIT
PPRT4 ;Print pathogens 11,12,13,14
+1 DO HDG^LREPIRP7
WRITE !
+2 SET LRNOPAT=""
SET LRNOPAT=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,LRNOPAT))
+3 IF LRNOPAT="HDG"
WRITE !!,"NO PATIENTS REPORTED FOR THE REPORT PERIOD."
+4 FOR
SET LRDFN=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN))
if 'LRDFN
QUIT
Begin DoDot:1
+5 SET LRPV1=0
SET LRDG1=0
+6 SET LRPID=$GET(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PID"))
+7 WRITE !,LRPID
+8 FOR
SET LRPV1=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1))
if 'LRPV1
QUIT
Begin DoDot:2
+9 WRITE !,$GET(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1))
+10 SET LRDG1=0
+11 FOR
SET LRDG1=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"DG1",LRDG1))
if 'LRDG1
QUIT
Begin DoDot:3
+12 WRITE !,$GET(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,"PV1",LRPV1,"DG1",LRDG1))
End DoDot:3
if LRQUIT
QUIT
End DoDot:2
if LRQUIT
QUIT
+13 IF $Y>(IOSL-6)
DO NPG^LREPIRP7
End DoDot:1
if LRQUIT
QUIT
+14 QUIT
