Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LREPIRP7

LREPIRP7.m

Go to the documentation of this file. 
  1. LREPIRP7 ;VA/DALOI/CKA - EPI-PRINT VERIFICATION REPORT ; 17-Oct-2014 09:22 ; MKK
  1.  ;;5.2;LAB SERVICE;**281,320,1030,1034**;NOV 01, 1997;Build 88
  1.  ;
  1.  ; Reference to X ^DD("DD") supported by IA #10017
  1.  ;USED TO PRINT VERIFICATION REPORT
  1.  W !?5,"Print Detailed Verification Report Option",!!
  1. CHOOSE ;which date report to print
  1.  S LRNODE="LREPIREP",LRDATE=0,LRNUM=1
  1.  F  S LRNODE=$O(^XTMP(LRNODE)) Q:LRNODE=""!(LRNODE'["LREPIREP")  S LRDATE=$E(LRNODE,9,22) D
  1.  .S Y=LRDATE X ^DD("DD") S LRREP(LRNUM)=LRDATE_"^"_Y,LRNUM=LRNUM+1
  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)
  1.  S LRNUM=LRNUM-1
  1.  S DIR(0)="NO^1:"_LRNUM
  1.  S DIR("A")="Choose the number for the report you wish to print"
  1.  D ^DIR
  1.  G:$D(DIRUT) EXIT
  1.  S LRREP=Y
  1.  K DIR,DIRUT
  1.  G:$D(DIRUT) CHOOSE
  1.  S LRDATE=$P(LRREP(LRREP),"^")
  1.  I '$D(^XTMP("LREPIREP"_LRDATE,"DONE")) D  Q
  1.  .W !!
  1.  .W !?5,"This report is not completed generating."
  1.  .W !?5,"Please try again later."
  1.  .S LREND=1
  1. PRIV ;PRIVACY MESSAGE
  1.  W !!!,"This report will contain Confidential Information."
  1.  K DIR S DIR(0)="Y",DIR("A")="Do you wish to continue/proceed"
  1.  S DIR("B")="NO"
  1.  D ^DIR S:$D(DIRUT) LREND=1
  1.  G:'Y EXIT
  1. ALL K DIR,DIRUT
  1.  S DIR(0)="Y",DIR("B")="NO",DIR("A")="Include All Pathogens"
  1.  S DIR("?")="Enter (Y)es or return for all entries to be Selected"
  1.  D ^DIR
  1.  S LRALL=+Y
  1.  K DIR
  1.  I +LRALL'>0 D
  1.  .W @IOF
  1.  .F  Q:$D(DIRUT)  D  Q:X=""
  1.  ..S DIR(0)="PAO^69.5:EMZ",DIR("A")="Select Pathogens: "
  1.  ..S DIR("?")="Select the Pathogens. "
  1.  ..S DIR("S")="I Y<100"
  1.  ..D ^DIR
  1.  ..Q:$D(DIRUT)!(Y=-1)
  1.  ..S LREPI($P(^LAB(69.5,+Y,0),U,9))=+Y
  1.  ..K DIR,DTOUT,DUOUT,DIRUT
  1.  G:$D(DTOUT)!$D(DUOUT) Q
  1.  I '$D(LREPI)&('LRALL) W !,"Sorry No Pathogens Selected" G CHOOSE
  1.  D REP
  1. EXIT ;
  1.  D ^%ZISC
  1.  K DIC,D0,LRAUTO,LRBEG,LRDT,LREND,LRRNDT,LREPI,LRRPE,LRRPS,ZTSAVE
  1.  K ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK,X,Y,X1,%DT,POP,%ZIS
  1.  K LRCOUNT,LRLC,LRHDG,LRQUIT,LRHDGLC,LRPAGE,LRNODE
  1.  K DIR,DIRUT,DTOUT,DUOUT,J,LRMSGLIN,LRREP,LRSPSHT,MSG
  1.  K LRALL,LRCOUNT,LRDATE,LRDFN,LRDG1,LRDSPCNT,LRNUM,LROBR,LROBX,LRPAGE
  1.  K LRPATH,LRPID,LRSEG,LRTYPE,LRUPDNUM,LRZXECNT
  1.  K LRSBCNT,LRPV1,LRNOPAT,LRADMDT,LRDG1CNT,LRDISDT,LRDSP,LRDTHDG,LRHDGL2
  1.  K LRI,LRNAME,LRNTECNT,LRNUM1,LROBRCNT,LROBXCNT,LRPATHCT,LRPERCNT
  1.  K LRPV1CNT,LRPV1N,LRPV1ND,LRSUBCNT,LRTMP,LRTOT,LRTOTCNT,LRZXE,SITE,SSN
  1.  K ZTREQ
  1.  Q
  1.  ;
  1. REP ;
  1. Q S %ZIS="Q" D ^%ZIS Q:POP  I '$D(IO("Q")) U IO D PRT Q
  1.  S ZTRTN="PRT^LREPIRP7",ZTSAVE("LR*")="",ZTDESC="PRINT EPI VERIFICATION REPORT",ZTREQ="@" D ^%ZTLOAD
  1.  I $D(ZTSK)[0 W !!?5,"Report Cancelled."
  1.  E  W !!?5,"The Task has been queued",!,"Task #",$G(ZTSK) H 5
  1.  D HOME^%ZIS G EXIT
  1.  Q
  1. PRT ;Print report
  1.  I 'LRALL D PATH G EXIT
  1.  S LRPATH=0,LRDFN=0,LRPV1=0,LROBR=0,LROBX=0,LRPAGE=1,LRQUIT=0,LRNUM=0
  1.  S LRPATH=1 D PPRT1^LREPIRP8
  1.  I LRQUIT G EXIT
  1.  S LRDFN=0,LRPV1=0,LRDG1=0
  1.  S LRPATH=2 D PPRT3^LREPIRP8
  1.  I LRQUIT G EXIT
  1.  S LRDFN=0
  1.  F LRPATH=3,4,5,6 D PPRT1^LREPIRP8 Q:LRQUIT  S LRDFN=0
  1.  I LRQUIT G EXIT
  1.  S LRDFN=0,LRPV1=0,LRDG1=0
  1.  S LRPATH=7 D PPRT2^LREPIRP8
  1.  I LRQUIT G EXIT
  1.  S LRDFN=0,LRNUM=0
  1.  S LRPATH=8 D PPRT1^LREPIRP8
  1.  I LRQUIT G EXIT
  1.  S LRDFN=0,LRPV1=0,LRDG1=0
  1.  S LRPATH=9 D PPRT2^LREPIRP8
  1.  I LRQUIT G EXIT
  1.  S LRDFN=0,LRNUM=0
  1.  S LRPATH=10 D PPRT1^LREPIRP8
  1.  I LRQUIT G EXIT
  1.  S LRDFN=0,LRPV1=0,LRDG1=0
  1.  F LRPATH=11,12,13,14 D PPRT4^LREPIRP8 Q:LRQUIT
  1.  I LRQUIT G EXIT
  1.  S LRDFN=0,LRPV1=0,LROBR=0,LROBX=0,LRDG1=0
  1.  F LRPATH=15,16,17 D PPRT3^LREPIRP8 Q:LRQUIT  S LRDFN=0
  1.  I LRQUIT G EXIT
  1.  S LRDFN=0
  1.  F LRPATH=18,19,20,21,22,23 D PPRT1^LREPIRP8 Q:LRQUIT  S LRDFN=0
  1.  I LRQUIT G EXIT
  1.  S LRDFN=0,LRPV1=0,LRDG1=0
  1.  W @IOF
  1.  W !,?70,"  PAGE ",LRPAGE
  1.  S LRHDGLC=0,LRLC=0
  1.  F  S LRHDGLC=$O(^XTMP("LREPIREP"_LRDATE,"UPDHDG",LRHDGLC)) Q:LRHDGLC=""  W !,^(LRHDGLC)
  1.  S LRPAGE=LRPAGE+1
  1.  W !!,"Name                     LAST 4  Admission date     Discharge date"
  1.  W !,"__________________________________________________________________"
  1.  S LRUPDNUM=0
  1.  F  S LRUPDNUM=$O(^XTMP("LREPIREP"_LRDATE,"UPDATES",LRUPDNUM)) Q:LRUPDNUM=""  W !,^(LRUPDNUM) I $Y>(IOSL+14) D NPG
  1.  W @IOF
  1.  W !,?70,"PAGE ",LRPAGE
  1.  S LRHDGLC=0,LRLC=0
  1.  F  S LRHDGLC=$O(^XTMP("LREPIREP"_LRDATE,"PHHDG",LRHDGLC)) Q:LRHDGLC=""  W !,^(LRHDGLC)
  1.  S LRPAGE=LRPAGE+1
  1.  W !!
  1.  S LRTYPE="",LRZXECNT=0,LRCOUNT=0,LRSBCNT=0,LRDFN=0
  1.  F  S LRTYPE=$O(^XTMP("LREPIREP"_LRDATE,"ZXE",LRTYPE)) Q:LRTYPE=""  D  D ZXETOT S LRSBCNT=0
  1.  .W !,LRTYPE
  1.  .F  S LRDFN=$O(^XTMP("LREPIREP"_LRDATE,"ZXE",LRTYPE,LRDFN)) Q:LRDFN=""  D
  1.  ..F  S LRZXECNT=$O(^XTMP("LREPIREP"_LRDATE,"ZXE",LRTYPE,LRDFN,LRZXECNT)) Q:LRZXECNT=""  D
  1.  ...W !,?5,^XTMP("LREPIREP"_LRDATE,"ZXE",LRTYPE,LRDFN,LRZXECNT)
  1.  ...S LRSBCNT=LRSBCNT+1
  1.  ...I $Y>(IOSL+1) D NPG
  1.  W !,"------------------------------------------------------------"
  1.  W !?5,"COUNT ",LRCOUNT
  1.  W @IOF
  1.  W !?70,"PAGE ",LRPAGE
  1.  S LRHDGLC=0,LRLC=LRLC+1,LRCOUNT=0,LRSUBCNT=0
  1.  F  S LRHDGLC=$O(^XTMP("LREPIREP"_LRDATE,"HEPCHDG",LRHDGLC)) Q:LRHDGLC=""  W !,^(LRHDGLC)
  1.  S LRPAGE=LRPAGE+1
  1.  W !!
  1.  F LRNUM=1:1:7 W !! D
  1.  .I LRNUM=1 W !,"DECLINED ASSESSMENT FOR HEPATITIS C"
  1.  .I LRNUM=2 W !,"NO RISK FACTORS FOR HEPATITIS C"
  1.  .I LRNUM=3 W !,"PREVIOUSLY ASSESSED FOR HEPATITIS C"
  1.  .I LRNUM=4 W !,"RISK FACTORS FOR HEPATITIS C"
  1.  .I LRNUM=5 W !,"POSITIVE TEST FOR HEPATITIS C ANTIBODY"
  1.  .I LRNUM=6 W !,"NEGATIVE TEST FOR HEPATITIS C ANTIBODY"
  1.  .; I LRNUM=7 W !,"HEPATITIS C DIAGNOSIS (ICD-9 BASED)"
  1.  .I LRNUM=7 W !,"HEPATITIS C DIAGNOSIS (ICD BASED)"   ; IHS/MSC/MKK - LR*5.2*1034
  1.  .W !,"--------------------------------------"
  1.  .S LRTOT(LRNUM)=$G(^XTMP("LREPIREP"_LRDATE,"HEPTOT",LRNUM))
  1.  .I LRTOT(LRNUM)="" W !!,"NO PATIENTS REPORTED FOR THE REPORT PERIOD" Q
  1.  .S LRTYPE="",LRDSPCNT=0,LRCOUNT=0,LRSBCNT=0,LRDFN=0
  1.  .F  S LRTYPE=$O(^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE)) Q:LRTYPE=""  D  D:LRSBCNT>0 DSPTOT S LRSBCNT=0
  1.  ..F  S LRDFN=$O(^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN)) Q:LRDFN=""  D
  1.  ...F  S LRDSPCNT=$O(^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT)) Q:LRDSPCNT=""  D
  1.  ....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
  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
  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
  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
  1.  ....I LRNUM=5&(LRTYPE="HEP C VIRUS ANTIBODY POSITIVE") W !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT) S LRSBCNT=LRSBCNT+1
  1.  ....I LRNUM=6&(LRTYPE="HEP C VIRUS ANTIBODY NEGATIVE") W !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT) S LRSBCNT=LRSBCNT+1
  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
  1.  W !,"-----------------------------------------------------------------"
  1.  W !?5,"COUNT ",LRCOUNT
  1.  K MSGLIN,LRSEG
  1.  Q
  1. PATH S LRPATH=0,LRDFN=0,LRPV1=0,LROBR=0,LROBX=0,LRPAGE=1,LRQUIT=0
  1.  F  S LRPATH=$O(LREPI(LRPATH)) Q:'LRPATH  D  Q:LRQUIT  S LRDFN=0
  1.  .I LRPATH=11!(LRPATH=12)!(LRPATH=13)!(LRPATH=14) D PPRT4^LREPIRP8 Q
  1.  .I LRPATH=7!(LRPATH=9) D PPRT2^LREPIRP8 Q
  1.  .I LRPATH=2!(LRPATH=15)!(LRPATH=16)!(LRPATH=17) D PPRT3^LREPIRP8 Q
  1.  .D PPRT1^LREPIRP8
  1.  G EXIT
  1.  Q
  1. ZXETOT ;PRINT PHARMACY SUBTOTALS
  1.  W !,"---------------------------------------------------------------"
  1.  W !,?5,"SUBCOUNT  ",LRSBCNT
  1.  W !!
  1.  S LRCOUNT=LRCOUNT+LRSBCNT
  1.  Q
  1. DSPTOT W !,"---------------------------------------------------------------"
  1.  W !?5,"SUBCOUNT  ",LRSBCNT
  1.  W !!
  1.  S LRCOUNT=LRCOUNT+LRSBCNT
  1.  Q
  1. PAUSE ;
  1.  Q:$G(LREND)
  1.  K DIR S DIR(0)="E" D ^DIR
  1.  S:($D(DTOUT))!($D(DUOUT)) LRQUIT=1
  1.  Q
  1. NPG ;NEW PAGE
  1.  D:$E(IOST,1,2)="C-" PAUSE
  1.  Q:$G(LRQUIT)
  1.  W @IOF
  1.  Q
  1. HDG ;
  1.  W @IOF
  1.  S LRLC=0
  1.  W !,?70,"  PAGE ",LRPAGE
  1.  F LRHDGLC=1:1:3 S LRHDG=$G(^XTMP("LREPIREP"_LRDATE,"HDG",LRHDGLC)) D
  1.  .W !,LRHDG
  1.  .S LRLC=LRLC+1
  1.  W ! S LRLC=LRLC+1
  1.  S LRHDGLC=0
  1.  F  S LRHDGLC=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,"HDG",LRHDGLC)) Q:LRHDGLC=""  D
  1.  .S LRHDG=$G(^XTMP("LREPIREP"_LRDATE,LRPATH,"HDG",LRHDGLC))
  1.  .W !,LRHDG
  1.  .S LRLC=LRLC+1
  1.  S LRPAGE=LRPAGE+1
  1.  Q