VistA-WorldVistAEHR/r/ICR_IMMUNOLOGY_CASE_REGISTR.../IMRPNEU1.m

62 lines
2.2 KiB
Mathematica

IMRPNEU1 ;;HCIOFO/FT-Pneumococcal Immunization Rpt ;(cont.) 1/20/98 11:33
;;2.1;IMMUNOLOGY CASE REGISTRY;;Feb 09, 1998
; show all living ICR patients who have not had a pneumococcal
; vaccination in the last 5 years
I '$D(^XUSEC("IMRA",DUZ)) S IMRLOC="IMRPNEUM" D ACESSERR^IMRERR,H^XUS K IMRLOC
; select device
D IMRDEV^IMREDIT I POP D KILL^IMRPNEUM Q
I $D(IO("Q")) D D KILL^IMRPNEUM Q
.S ZTRTN="START^IMRPNEU1",ZTDESC="Immunology No Pneumo-Vac Report",ZTIO=ION_";"_IOM_";"_IOSL
.D ^%ZTLOAD
.K ZTRTN,ZTDESC,ZTSK,ZTIO,ZTSAVE
.Q
START ; start report
U IO K ^TMP($J)
S (IMRCNT,IMRDFN,IMRPG,IMRUT)=0,IMRLINE=$$REPEAT^XLFSTR("-",79)
S IMR5YR=DT-50000 ;calculate date of 5 years ago
D GETNOW^IMRACESS ;get the current date/time
D HDR
S X="PXRHS03" X ^%ZOSF("TEST")
I '$T D NODATA^IMRPNEUM,EOP^IMRPNEUM,KILL^IMRPNEUM Q
F S IMRDFN=$O(^IMR(158,IMRDFN)) Q:'IMRDFN D
.Q:$P($G(^IMR(158,IMRDFN,5)),U,19)>0 ;quit if patient is dead
.S X=+^IMR(158,IMRDFN,0) D ^IMRXOR
.I $D(^DPT(X,0)) D A1
.Q
I '$D(^TMP($J)) D NODATA^IMRPNEUM,EOP^IMRPNEUM,KILL^IMRPNEUM Q
S IMRNAME=""
F S IMRNAME=$O(^TMP($J,IMRNAME)) Q:IMRNAME=""!(IMRUT) S IMRDFN=0 F S IMRDFN=$O(^TMP($J,IMRNAME,IMRDFN)) Q:'IMRDFN!(IMRUT) D
.I ($Y+4)>IOSL D EOP^IMRPNEUM Q:IMRUT D HDR
.S IMRNODE=$G(^TMP($J,IMRNAME,IMRDFN))
.S IMRSSN=$P(IMRNODE,U,1),IMRVISIT=$P(IMRNODE,U,2)
.W !,IMRNAME,?32,IMRSSN,?50,$$FMTE^XLFDT(IMRVISIT,"1D")
.Q
W !!,"Total: ",IMRCNT
D:'IMRUT EOP^IMRPNEUM
S:$D(ZTQUEUED) ZTREQ="@"
KILL ; kill variables
D KILL^IMRPNEUM
Q
A1 ; get data from PCE utility
K ^TMP("PXI",$J) S IMR1=X
D IMMUN^PXRHS03(IMR1)
S IMRLOOP=+$O(^TMP("PXI",$J,"PNEUMO-VAC",0))
S IMRLOOP(1)=+$O(^TMP("PXI",$J,"PNEUMO-VAC",IMRLOOP,0))
S IMRVISIT=$P($G(^TMP("PXI",$J,"PNEUMO-VAC",IMRLOOP,IMRLOOP(1),0)),U,3)
I 'IMRVISIT!(IMRVISIT<IMR5YR) D
.S IMRNODE=$G(^DPT(IMR1,0))
.S:IMRVISIT="" IMRVISIT="None on file"
.S IMRNAME=$P(IMRNODE,U,1),IMRSSN=$P(IMRNODE,U,9)
.S ^TMP($J,IMRNAME,IMRDFN)=IMRSSN_U_IMRVISIT
.S IMRCNT=IMRCNT+1
.Q
Q
HDR ; report header
W:$Y>0 @IOF
S IMRPG=IMRPG+1
W !?25,"5 YEAR PNEUMOCOCCAL VACCINATION WARNING",?70,"Page ",IMRPG
W !?25,"Run Date: ",IMRDTE
W !,"NAME",?32,"SSN",?50,"LAST PNEUMO-VAC DATE"
W !,IMRLINE
Q