- 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 Dec 13, 2024@02:14:30 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