LREPIRP7 ;DALOI/CKA - EPI-PRINT VERIFICATION REPORT ;23 Apr 2013 4:33 PM
;;5.2;LAB SERVICE;**281,320,421**;Sep 27, 1994;Build 48
; Reference to X ^DD("DD") supported by IA #10017
;USED TO PRINT VERIFICATION REPORT
W !?5,"Print Detailed Verification Report Option",!!
CHOOSE ;which date report to print
S LRNODE="LREPIREP",LRDATE=0,LRNUM=1
F S LRNODE=$O(^XTMP(LRNODE)) Q:LRNODE=""!(LRNODE'["LREPIREP") S LRDATE=$E(LRNODE,9,22) D
.S Y=LRDATE X ^DD("DD") S LRREP(LRNUM)=LRDATE_"^"_Y,LRNUM=LRNUM+1
F LRNUM=1:1 Q:'$D(LRREP(LRNUM)) W !,LRNUM_" "_$P(LRREP(LRNUM),"^",2),$E(^XTMP("LREPIREP"_$P(LRREP(LRNUM),"^"),"HDG",3),12,99)
S LRNUM=LRNUM-1
S DIR(0)="NO^1:"_LRNUM
S DIR("A")="Choose the number for the report you wish to print"
D ^DIR
G:$D(DIRUT) EXIT
S LRREP=Y
K DIR,DIRUT
G:$D(DIRUT) CHOOSE
S LRDATE=$P(LRREP(LRREP),"^")
I '$D(^XTMP("LREPIREP"_LRDATE,"DONE")) D Q
.W !!
.W !?5,"This report is not completed generating."
.W !?5,"Please try again later."
.S LREND=1
PRIV ;PRIVACY MESSAGE
W !!!,"This report will contain Confidential Information."
K DIR S DIR(0)="Y",DIR("A")="Do you wish to continue/proceed"
S DIR("B")="NO"
D ^DIR S:$D(DIRUT) LREND=1
G:'Y EXIT
ALL K DIR,DIRUT
S DIR(0)="Y",DIR("B")="NO",DIR("A")="Include All Pathogens"
S DIR("?")="Enter (Y)es or return for all entries to be Selected"
D ^DIR
S LRALL=+Y
K DIR
I +LRALL'>0 D
.W @IOF
.F Q:$D(DIRUT) D Q:X=""
..S DIR(0)="PAO^69.5:EMZ",DIR("A")="Select Pathogens: "
..S DIR("?")="Select the Pathogens. "
..S DIR("S")="I Y<100"
..D ^DIR
..Q:$D(DIRUT)!(Y=-1)
..S LREPI($P(^LAB(69.5,+Y,0),U,9))=+Y
..K DIR,DTOUT,DUOUT,DIRUT
G:$D(DTOUT)!$D(DUOUT) Q
I '$D(LREPI)&('LRALL) W !,"Sorry No Pathogens Selected" G CHOOSE
D REP
EXIT ;
D ^%ZISC
K DIC,D0,LRAUTO,LRBEG,LRDT,LREND,LRRNDT,LREPI,LRRPE,LRRPS,ZTSAVE
K ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK,X,Y,X1,%DT,POP,%ZIS
K LRCOUNT,LRLC,LRHDG,LRQUIT,LRHDGLC,LRPAGE,LRNODE
K DIR,DIRUT,DTOUT,DUOUT,J,LRMSGLIN,LRREP,LRSPSHT,MSG
K LRALL,LRCOUNT,LRDATE,LRDFN,LRDG1,LRDSPCNT,LRNUM,LROBR,LROBX,LRPAGE
K LRPATH,LRPID,LRSEG,LRTYPE,LRUPDNUM,LRZXECNT
K LRSBCNT,LRPV1,LRNOPAT,LRADMDT,LRDG1CNT,LRDISDT,LRDSP,LRDTHDG,LRHDGL2
K LRI,LRNAME,LRNTECNT,LRNUM1,LROBRCNT,LROBXCNT,LRPATHCT,LRPERCNT
K LRPV1CNT,LRPV1N,LRPV1ND,LRSUBCNT,LRTMP,LRTOT,LRTOTCNT,LRZXE,SITE,SSN
K ZTREQ
Q
;
REP ;
Q S %ZIS="Q" D ^%ZIS Q:POP I '$D(IO("Q")) U IO D PRT Q
S ZTRTN="PRT^LREPIRP7",ZTSAVE("LR*")="",ZTDESC="PRINT EPI VERIFICATION REPORT",ZTREQ="@" D ^%ZTLOAD
I $D(ZTSK)[0 W !!?5,"Report Cancelled."
E W !!?5,"The Task has been queued",!,"Task #",$G(ZTSK) H 5
D HOME^%ZIS G EXIT
Q
PRT ;Print report
I 'LRALL D PATH G EXIT
S LRPATH=0,LRDFN=0,LRPV1=0,LROBR=0,LROBX=0,LRPAGE=1,LRQUIT=0,LRNUM=0
S LRPATH=1 D PPRT1^LREPIRP8
I LRQUIT G EXIT
S LRDFN=0,LRPV1=0,LRDG1=0
S LRPATH=2 D PPRT3^LREPIRP8
I LRQUIT G EXIT
S LRDFN=0
F LRPATH=3,4,5,6 D PPRT1^LREPIRP8 Q:LRQUIT S LRDFN=0
I LRQUIT G EXIT
S LRDFN=0,LRPV1=0,LRDG1=0
S LRPATH=7 D PPRT2^LREPIRP8
I LRQUIT G EXIT
S LRDFN=0,LRNUM=0
S LRPATH=8 D PPRT1^LREPIRP8
I LRQUIT G EXIT
S LRDFN=0,LRPV1=0,LRDG1=0
S LRPATH=9 D PPRT2^LREPIRP8
I LRQUIT G EXIT
S LRDFN=0,LRNUM=0
S LRPATH=10 D PPRT1^LREPIRP8
I LRQUIT G EXIT
S LRDFN=0,LRPV1=0,LRDG1=0
F LRPATH=11,12,13,14 D PPRT4^LREPIRP8 Q:LRQUIT S LRDFN=0
I LRQUIT G EXIT
S LRDFN=0,LRPV1=0,LROBR=0,LROBX=0,LRDG1=0
F LRPATH=15,16,17 D PPRT3^LREPIRP8 Q:LRQUIT S LRDFN=0
I LRQUIT G EXIT
S LRDFN=0
F LRPATH=18,19,20,21,22,23 D PPRT1^LREPIRP8 Q:LRQUIT S LRDFN=0
I LRQUIT G EXIT
S LRDFN=0,LRPV1=0,LRDG1=0
W @IOF
W !,?70," PAGE ",LRPAGE
S LRHDGLC=0,LRLC=0
F S LRHDGLC=$O(^XTMP("LREPIREP"_LRDATE,"UPDHDG",LRHDGLC)) Q:LRHDGLC="" W !,^(LRHDGLC)
S LRPAGE=LRPAGE+1
W !!,"Name LAST 4 Admission date Discharge date"
W !,"__________________________________________________________________"
S LRUPDNUM=0
F S LRUPDNUM=$O(^XTMP("LREPIREP"_LRDATE,"UPDATES",LRUPDNUM)) Q:LRUPDNUM="" W !,^(LRUPDNUM) I $Y>(IOSL+14) D NPG
W @IOF
W !,?70,"PAGE ",LRPAGE
S LRHDGLC=0,LRLC=0
F S LRHDGLC=$O(^XTMP("LREPIREP"_LRDATE,"PHHDG",LRHDGLC)) Q:LRHDGLC="" W !,^(LRHDGLC)
S LRPAGE=LRPAGE+1
W !!
S LRTYPE="",LRZXECNT=0,LRCOUNT=0,LRSBCNT=0,LRDFN=0
F S LRTYPE=$O(^XTMP("LREPIREP"_LRDATE,"ZXE",LRTYPE)) Q:LRTYPE="" D D ZXETOT S LRSBCNT=0
.W !,LRTYPE
.F S LRDFN=$O(^XTMP("LREPIREP"_LRDATE,"ZXE",LRTYPE,LRDFN)) Q:LRDFN="" D
..F S LRZXECNT=$O(^XTMP("LREPIREP"_LRDATE,"ZXE",LRTYPE,LRDFN,LRZXECNT)) Q:LRZXECNT="" D
...W !,?5,^XTMP("LREPIREP"_LRDATE,"ZXE",LRTYPE,LRDFN,LRZXECNT)
...S LRSBCNT=LRSBCNT+1
...I $Y>(IOSL+1) D NPG
W !,"------------------------------------------------------------"
W !?5,"COUNT ",LRCOUNT
W @IOF
W !?70,"PAGE ",LRPAGE
S LRHDGLC=0,LRLC=LRLC+1,LRCOUNT=0,LRSUBCNT=0
F S LRHDGLC=$O(^XTMP("LREPIREP"_LRDATE,"HEPCHDG",LRHDGLC)) Q:LRHDGLC="" W !,^(LRHDGLC)
S LRPAGE=LRPAGE+1
W !!
F LRNUM=1:1:7 W !! D
.I LRNUM=1 W !,"DECLINED ASSESSMENT FOR HEPATITIS C"
.I LRNUM=2 W !,"NO RISK FACTORS FOR HEPATITIS C"
.I LRNUM=3 W !,"PREVIOUSLY ASSESSED FOR HEPATITIS C"
.I LRNUM=4 W !,"RISK FACTORS FOR HEPATITIS C"
.I LRNUM=5 W !,"POSITIVE TEST FOR HEPATITIS C ANTIBODY"
.I LRNUM=6 W !,"NEGATIVE TEST FOR HEPATITIS C ANTIBODY"
.I LRNUM=7 W !,"HEPATITIS C DIAGNOSIS (ICD BASED)"
.W !,"--------------------------------------"
.S LRTOT(LRNUM)=$G(^XTMP("LREPIREP"_LRDATE,"HEPTOT",LRNUM))
.I LRTOT(LRNUM)="" W !!,"NO PATIENTS REPORTED FOR THE REPORT PERIOD" Q
.S LRTYPE="",LRDSPCNT=0,LRCOUNT=0,LRSBCNT=0,LRDFN=0
.F S LRTYPE=$O(^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE)) Q:LRTYPE="" D D:LRSBCNT>0 DSPTOT S LRSBCNT=0
..F S LRDFN=$O(^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN)) Q:LRDFN="" D
...F S LRDSPCNT=$O(^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT)) Q:LRDSPCNT="" D
....I LRNUM=1&(LRTYPE="DECLINED HEP C RISK ASSESSMENT") W !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT) D:($Y>(IOSL+11)) NPG S LRSBCNT=LRSBCNT+1
....I LRNUM=2&(LRTYPE="NO RISK FACTORS FOR HEP C") W !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT) D:($Y>(IOSL+11)) NPG S LRSBCNT=LRSBCNT+1
....I LRNUM=3&(LRTYPE="PREVIOUSLY ASSESSED HEP C RISK") W !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT) D:($Y>(IOSL+11)) NPG S LRSBCNT=LRSBCNT+1
....I LRNUM=4&(LRTYPE="RISK FACTOR FOR HEPATITIS C") W !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT) D:($Y>(IOSL+11)) NPG S LRSBCNT=LRSBCNT+1
....I LRNUM=5&(LRTYPE="HEP C VIRUS ANTIBODY POSITIVE") W !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT) S LRSBCNT=LRSBCNT+1
....I LRNUM=6&(LRTYPE="HEP C VIRUS ANTIBODY NEGATIVE") W !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT) S LRSBCNT=LRSBCNT+1
....I LRNUM=7&(LRTYPE="HEPATITIS C INFECTION") W !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT) D:($Y>(IOSL+11)) NPG S LRSBCNT=LRSBCNT+1
W !,"-----------------------------------------------------------------"
W !?5,"COUNT ",LRCOUNT
K MSGLIN,LRSEG
Q
PATH S LRPATH=0,LRDFN=0,LRPV1=0,LROBR=0,LROBX=0,LRPAGE=1,LRQUIT=0
F S LRPATH=$O(LREPI(LRPATH)) Q:'LRPATH D Q:LRQUIT S LRDFN=0
.I LRPATH=11!(LRPATH=12)!(LRPATH=13)!(LRPATH=14) D PPRT4^LREPIRP8 Q
.I LRPATH=7!(LRPATH=9) D PPRT2^LREPIRP8 Q
.I LRPATH=2!(LRPATH=15)!(LRPATH=16)!(LRPATH=17) D PPRT3^LREPIRP8 Q
.D PPRT1^LREPIRP8
G EXIT
Q
ZXETOT ;PRINT PHARMACY SUBTOTALS
W !,"---------------------------------------------------------------"
W !,?5,"SUBCOUNT ",LRSBCNT
W !!
S LRCOUNT=LRCOUNT+LRSBCNT
Q
DSPTOT W !,"---------------------------------------------------------------"
W !?5,"SUBCOUNT ",LRSBCNT
W !!
S LRCOUNT=LRCOUNT+LRSBCNT
Q
PAUSE ;
Q:$G(LREND)
K DIR S DIR(0)="E" D ^DIR
S:($D(DTOUT))!($D(DUOUT)) LRQUIT=1
Q
NPG ;NEW PAGE
D:$E(IOST,1,2)="C-" PAUSE
Q:$G(LRQUIT)
W @IOF
Q
HDG ;
W @IOF
S LRLC=0
W !,?70," PAGE ",LRPAGE
F LRHDGLC=1:1:3 S LRHDG=$G(^XTMP("LREPIREP"_LRDATE,"HDG",LRHDGLC)) D
.W !,LRHDG
.S LRLC=LRLC+1
W ! S LRLC=LRLC+1
S LRHDGLC=0
F S LRHDGLC=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,"HDG",LRHDGLC)) Q:LRHDGLC="" D
.S LRHDG=$G(^XTMP("LREPIREP"_LRDATE,LRPATH,"HDG",LRHDGLC))
.W !,LRHDG
.S LRLC=LRLC+1
S LRPAGE=LRPAGE+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREPIRP7 8282 printed Dec 13, 2024@02:14:29 Page 2
LREPIRP7 ;DALOI/CKA - EPI-PRINT VERIFICATION REPORT ;23 Apr 2013 4:33 PM
+1 ;;5.2;LAB SERVICE;**281,320,421**;Sep 27, 1994;Build 48
+2 ; Reference to X ^DD("DD") supported by IA #10017
+3 ;USED TO PRINT VERIFICATION REPORT
+4 WRITE !?5,"Print Detailed Verification Report Option",!!
CHOOSE ;which date report to print
+1 SET LRNODE="LREPIREP"
SET LRDATE=0
SET LRNUM=1
+2 FOR
SET LRNODE=$ORDER(^XTMP(LRNODE))
if LRNODE=""!(LRNODE'["LREPIREP")
QUIT
SET LRDATE=$EXTRACT(LRNODE,9,22)
Begin DoDot:1
+3 SET Y=LRDATE
XECUTE ^DD("DD")
SET LRREP(LRNUM)=LRDATE_"^"_Y
SET LRNUM=LRNUM+1
End DoDot:1
+4 FOR LRNUM=1:1
if '$DATA(LRREP(LRNUM))
QUIT
WRITE !,LRNUM_" "_$PIECE(LRREP(LRNUM),"^",2),$EXTRACT(^XTMP("LREPIREP"_$PIECE(LRREP(LRNUM),"^"),"HDG",3),12,99)
+5 SET LRNUM=LRNUM-1
+6 SET DIR(0)="NO^1:"_LRNUM
+7 SET DIR("A")="Choose the number for the report you wish to print"
+8 DO ^DIR
+9 if $DATA(DIRUT)
GOTO EXIT
+10 SET LRREP=Y
+11 KILL DIR,DIRUT
+12 if $DATA(DIRUT)
GOTO CHOOSE
+13 SET LRDATE=$PIECE(LRREP(LRREP),"^")
+14 IF '$DATA(^XTMP("LREPIREP"_LRDATE,"DONE"))
Begin DoDot:1
+15 WRITE !!
+16 WRITE !?5,"This report is not completed generating."
+17 WRITE !?5,"Please try again later."
+18 SET LREND=1
End DoDot:1
QUIT
PRIV ;PRIVACY MESSAGE
+1 WRITE !!!,"This report will contain Confidential Information."
+2 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue/proceed"
+3 SET DIR("B")="NO"
+4 DO ^DIR
if $DATA(DIRUT)
SET LREND=1
+5 if 'Y
GOTO EXIT
ALL KILL DIR,DIRUT
+1 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Include All Pathogens"
+2 SET DIR("?")="Enter (Y)es or return for all entries to be Selected"
+3 DO ^DIR
+4 SET LRALL=+Y
+5 KILL DIR
+6 IF +LRALL'>0
Begin DoDot:1
+7 WRITE @IOF
+8 FOR
if $DATA(DIRUT)
QUIT
Begin DoDot:2
+9 SET DIR(0)="PAO^69.5:EMZ"
SET DIR("A")="Select Pathogens: "
+10 SET DIR("?")="Select the Pathogens. "
+11 SET DIR("S")="I Y<100"
+12 DO ^DIR
+13 if $DATA(DIRUT)!(Y=-1)
QUIT
+14 SET LREPI($PIECE(^LAB(69.5,+Y,0),U,9))=+Y
+15 KILL DIR,DTOUT,DUOUT,DIRUT
End DoDot:2
if X=""
QUIT
End DoDot:1
+16 if $DATA(DTOUT)!$DATA(DUOUT)
GOTO Q
+17 IF '$DATA(LREPI)&('LRALL)
WRITE !,"Sorry No Pathogens Selected"
GOTO CHOOSE
+18 DO REP
EXIT ;
+1 DO ^%ZISC
+2 KILL DIC,D0,LRAUTO,LRBEG,LRDT,LREND,LRRNDT,LREPI,LRRPE,LRRPS,ZTSAVE
+3 KILL ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK,X,Y,X1,%DT,POP,%ZIS
+4 KILL LRCOUNT,LRLC,LRHDG,LRQUIT,LRHDGLC,LRPAGE,LRNODE
+5 KILL DIR,DIRUT,DTOUT,DUOUT,J,LRMSGLIN,LRREP,LRSPSHT,MSG
+6 KILL LRALL,LRCOUNT,LRDATE,LRDFN,LRDG1,LRDSPCNT,LRNUM,LROBR,LROBX,LRPAGE
+7 KILL LRPATH,LRPID,LRSEG,LRTYPE,LRUPDNUM,LRZXECNT
+8 KILL LRSBCNT,LRPV1,LRNOPAT,LRADMDT,LRDG1CNT,LRDISDT,LRDSP,LRDTHDG,LRHDGL2
+9 KILL LRI,LRNAME,LRNTECNT,LRNUM1,LROBRCNT,LROBXCNT,LRPATHCT,LRPERCNT
+10 KILL LRPV1CNT,LRPV1N,LRPV1ND,LRSUBCNT,LRTMP,LRTOT,LRTOTCNT,LRZXE,SITE,SSN
+11 KILL ZTREQ
+12 QUIT
+13 ;
REP ;
Q SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
IF '$DATA(IO("Q"))
USE IO
DO PRT
QUIT
+1 SET ZTRTN="PRT^LREPIRP7"
SET ZTSAVE("LR*")=""
SET ZTDESC="PRINT EPI VERIFICATION REPORT"
SET ZTREQ="@"
DO ^%ZTLOAD
+2 IF $DATA(ZTSK)[0
WRITE !!?5,"Report Cancelled."
+3 IF '$TEST
WRITE !!?5,"The Task has been queued",!,"Task #",$GET(ZTSK)
HANG 5
+4 DO HOME^%ZIS
GOTO EXIT
+5 QUIT
PRT ;Print report
+1 IF 'LRALL
DO PATH
GOTO EXIT
+2 SET LRPATH=0
SET LRDFN=0
SET LRPV1=0
SET LROBR=0
SET LROBX=0
SET LRPAGE=1
SET LRQUIT=0
SET LRNUM=0
+3 SET LRPATH=1
DO PPRT1^LREPIRP8
+4 IF LRQUIT
GOTO EXIT
+5 SET LRDFN=0
SET LRPV1=0
SET LRDG1=0
+6 SET LRPATH=2
DO PPRT3^LREPIRP8
+7 IF LRQUIT
GOTO EXIT
+8 SET LRDFN=0
+9 FOR LRPATH=3,4,5,6
DO PPRT1^LREPIRP8
if LRQUIT
QUIT
SET LRDFN=0
+10 IF LRQUIT
GOTO EXIT
+11 SET LRDFN=0
SET LRPV1=0
SET LRDG1=0
+12 SET LRPATH=7
DO PPRT2^LREPIRP8
+13 IF LRQUIT
GOTO EXIT
+14 SET LRDFN=0
SET LRNUM=0
+15 SET LRPATH=8
DO PPRT1^LREPIRP8
+16 IF LRQUIT
GOTO EXIT
+17 SET LRDFN=0
SET LRPV1=0
SET LRDG1=0
+18 SET LRPATH=9
DO PPRT2^LREPIRP8
+19 IF LRQUIT
GOTO EXIT
+20 SET LRDFN=0
SET LRNUM=0
+21 SET LRPATH=10
DO PPRT1^LREPIRP8
+22 IF LRQUIT
GOTO EXIT
+23 SET LRDFN=0
SET LRPV1=0
SET LRDG1=0
+24 FOR LRPATH=11,12,13,14
DO PPRT4^LREPIRP8
if LRQUIT
QUIT
SET LRDFN=0
+25 IF LRQUIT
GOTO EXIT
+26 SET LRDFN=0
SET LRPV1=0
SET LROBR=0
SET LROBX=0
SET LRDG1=0
+27 FOR LRPATH=15,16,17
DO PPRT3^LREPIRP8
if LRQUIT
QUIT
SET LRDFN=0
+28 IF LRQUIT
GOTO EXIT
+29 SET LRDFN=0
+30 FOR LRPATH=18,19,20,21,22,23
DO PPRT1^LREPIRP8
if LRQUIT
QUIT
SET LRDFN=0
+31 IF LRQUIT
GOTO EXIT
+32 SET LRDFN=0
SET LRPV1=0
SET LRDG1=0
+33 WRITE @IOF
+34 WRITE !,?70," PAGE ",LRPAGE
+35 SET LRHDGLC=0
SET LRLC=0
+36 FOR
SET LRHDGLC=$ORDER(^XTMP("LREPIREP"_LRDATE,"UPDHDG",LRHDGLC))
if LRHDGLC=""
QUIT
WRITE !,^(LRHDGLC)
+37 SET LRPAGE=LRPAGE+1
+38 WRITE !!,"Name LAST 4 Admission date Discharge date"
+39 WRITE !,"__________________________________________________________________"
+40 SET LRUPDNUM=0
+41 FOR
SET LRUPDNUM=$ORDER(^XTMP("LREPIREP"_LRDATE,"UPDATES",LRUPDNUM))
if LRUPDNUM=""
QUIT
WRITE !,^(LRUPDNUM)
IF $Y>(IOSL+14)
DO NPG
+42 WRITE @IOF
+43 WRITE !,?70,"PAGE ",LRPAGE
+44 SET LRHDGLC=0
SET LRLC=0
+45 FOR
SET LRHDGLC=$ORDER(^XTMP("LREPIREP"_LRDATE,"PHHDG",LRHDGLC))
if LRHDGLC=""
QUIT
WRITE !,^(LRHDGLC)
+46 SET LRPAGE=LRPAGE+1
+47 WRITE !!
+48 SET LRTYPE=""
SET LRZXECNT=0
SET LRCOUNT=0
SET LRSBCNT=0
SET LRDFN=0
+49 FOR
SET LRTYPE=$ORDER(^XTMP("LREPIREP"_LRDATE,"ZXE",LRTYPE))
if LRTYPE=""
QUIT
Begin DoDot:1
+50 WRITE !,LRTYPE
+51 FOR
SET LRDFN=$ORDER(^XTMP("LREPIREP"_LRDATE,"ZXE",LRTYPE,LRDFN))
if LRDFN=""
QUIT
Begin DoDot:2
+52 FOR
SET LRZXECNT=$ORDER(^XTMP("LREPIREP"_LRDATE,"ZXE",LRTYPE,LRDFN,LRZXECNT))
if LRZXECNT=""
QUIT
Begin DoDot:3
+53 WRITE !,?5,^XTMP("LREPIREP"_LRDATE,"ZXE",LRTYPE,LRDFN,LRZXECNT)
+54 SET LRSBCNT=LRSBCNT+1
+55 IF $Y>(IOSL+1)
DO NPG
End DoDot:3
End DoDot:2
End DoDot:1
DO ZXETOT
SET LRSBCNT=0
+56 WRITE !,"------------------------------------------------------------"
+57 WRITE !?5,"COUNT ",LRCOUNT
+58 WRITE @IOF
+59 WRITE !?70,"PAGE ",LRPAGE
+60 SET LRHDGLC=0
SET LRLC=LRLC+1
SET LRCOUNT=0
SET LRSUBCNT=0
+61 FOR
SET LRHDGLC=$ORDER(^XTMP("LREPIREP"_LRDATE,"HEPCHDG",LRHDGLC))
if LRHDGLC=""
QUIT
WRITE !,^(LRHDGLC)
+62 SET LRPAGE=LRPAGE+1
+63 WRITE !!
+64 FOR LRNUM=1:1:7
WRITE !!
Begin DoDot:1
+65 IF LRNUM=1
WRITE !,"DECLINED ASSESSMENT FOR HEPATITIS C"
+66 IF LRNUM=2
WRITE !,"NO RISK FACTORS FOR HEPATITIS C"
+67 IF LRNUM=3
WRITE !,"PREVIOUSLY ASSESSED FOR HEPATITIS C"
+68 IF LRNUM=4
WRITE !,"RISK FACTORS FOR HEPATITIS C"
+69 IF LRNUM=5
WRITE !,"POSITIVE TEST FOR HEPATITIS C ANTIBODY"
+70 IF LRNUM=6
WRITE !,"NEGATIVE TEST FOR HEPATITIS C ANTIBODY"
+71 IF LRNUM=7
WRITE !,"HEPATITIS C DIAGNOSIS (ICD BASED)"
+72 WRITE !,"--------------------------------------"
+73 SET LRTOT(LRNUM)=$GET(^XTMP("LREPIREP"_LRDATE,"HEPTOT",LRNUM))
+74 IF LRTOT(LRNUM)=""
WRITE !!,"NO PATIENTS REPORTED FOR THE REPORT PERIOD"
QUIT
+75 SET LRTYPE=""
SET LRDSPCNT=0
SET LRCOUNT=0
SET LRSBCNT=0
SET LRDFN=0
+76 FOR
SET LRTYPE=$ORDER(^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE))
if LRTYPE=""
QUIT
Begin DoDot:2
+77 FOR
SET LRDFN=$ORDER(^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN))
if LRDFN=""
QUIT
Begin DoDot:3
+78 FOR
SET LRDSPCNT=$ORDER(^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT))
if LRDSPCNT=""
QUIT
Begin DoDot:4
+79 IF LRNUM=1&(LRTYPE="DECLINED HEP C RISK ASSESSMENT")
WRITE !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT)
if ($Y>(IOSL+11))
DO NPG
SET LRSBCNT=LRSBCNT+1
+80 IF LRNUM=2&(LRTYPE="NO RISK FACTORS FOR HEP C")
WRITE !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT)
if ($Y>(IOSL+11))
DO NPG
SET LRSBCNT=LRSBCNT+1
+81 IF LRNUM=3&(LRTYPE="PREVIOUSLY ASSESSED HEP C RISK")
WRITE !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT)
if ($Y>(IOSL+11))
DO NPG
SET LRSBCNT=LRSBCNT+1
+82 IF LRNUM=4&(LRTYPE="RISK FACTOR FOR HEPATITIS C")
WRITE !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT)
if ($Y>(IOSL+11))
DO NPG
SET LRSBCNT=LRSBCNT+1
+83 IF LRNUM=5&(LRTYPE="HEP C VIRUS ANTIBODY POSITIVE")
WRITE !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT)
SET LRSBCNT=LRSBCNT+1
+84 IF LRNUM=6&(LRTYPE="HEP C VIRUS ANTIBODY NEGATIVE")
WRITE !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT)
SET LRSBCNT=LRSBCNT+1
+85 IF LRNUM=7&(LRTYPE="HEPATITIS C INFECTION")
WRITE !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT)
if ($Y>(IOSL+11))
DO NPG
SET LRSBCNT=LRSBCNT+1
End DoDot:4
End DoDot:3
End DoDot:2
if LRSBCNT>0
DO DSPTOT
SET LRSBCNT=0
End DoDot:1
+86 WRITE !,"-----------------------------------------------------------------"
+87 WRITE !?5,"COUNT ",LRCOUNT
+88 KILL MSGLIN,LRSEG
+89 QUIT
PATH SET LRPATH=0
SET LRDFN=0
SET LRPV1=0
SET LROBR=0
SET LROBX=0
SET LRPAGE=1
SET LRQUIT=0
+1 FOR
SET LRPATH=$ORDER(LREPI(LRPATH))
if 'LRPATH
QUIT
Begin DoDot:1
+2 IF LRPATH=11!(LRPATH=12)!(LRPATH=13)!(LRPATH=14)
DO PPRT4^LREPIRP8
QUIT
+3 IF LRPATH=7!(LRPATH=9)
DO PPRT2^LREPIRP8
QUIT
+4 IF LRPATH=2!(LRPATH=15)!(LRPATH=16)!(LRPATH=17)
DO PPRT3^LREPIRP8
QUIT
+5 DO PPRT1^LREPIRP8
End DoDot:1
if LRQUIT
QUIT
SET LRDFN=0
+6 GOTO EXIT
+7 QUIT
ZXETOT ;PRINT PHARMACY SUBTOTALS
+1 WRITE !,"---------------------------------------------------------------"
+2 WRITE !,?5,"SUBCOUNT ",LRSBCNT
+3 WRITE !!
+4 SET LRCOUNT=LRCOUNT+LRSBCNT
+5 QUIT
DSPTOT WRITE !,"---------------------------------------------------------------"
+1 WRITE !?5,"SUBCOUNT ",LRSBCNT
+2 WRITE !!
+3 SET LRCOUNT=LRCOUNT+LRSBCNT
+4 QUIT
PAUSE ;
+1 if $GET(LREND)
QUIT
+2 KILL DIR
SET DIR(0)="E"
DO ^DIR
+3 if ($DATA(DTOUT))!($DATA(DUOUT))
SET LRQUIT=1
+4 QUIT
NPG ;NEW PAGE
+1 if $EXTRACT(IOST,1,2)="C-"
DO PAUSE
+2 if $GET(LRQUIT)
QUIT
+3 WRITE @IOF
+4 QUIT
HDG ;
+1 WRITE @IOF
+2 SET LRLC=0
+3 WRITE !,?70," PAGE ",LRPAGE
+4 FOR LRHDGLC=1:1:3
SET LRHDG=$GET(^XTMP("LREPIREP"_LRDATE,"HDG",LRHDGLC))
Begin DoDot:1
+5 WRITE !,LRHDG
+6 SET LRLC=LRLC+1
End DoDot:1
+7 WRITE !
SET LRLC=LRLC+1
+8 SET LRHDGLC=0
+9 FOR
SET LRHDGLC=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,"HDG",LRHDGLC))
if LRHDGLC=""
QUIT
Begin DoDot:1
+10 SET LRHDG=$GET(^XTMP("LREPIREP"_LRDATE,LRPATH,"HDG",LRHDGLC))
+11 WRITE !,LRHDG
+12 SET LRLC=LRLC+1
End DoDot:1
+13 SET LRPAGE=LRPAGE+1
+14 QUIT
