source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRPINQ1.m@ 1375

Last change on this file since 1375 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1IMRPINQ1 ;HCIOFO/FT/FAI-Patient Inquiry (cont) ;07/17/00 16:00
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;**5**;Feb 09, 1998
3 ; check security
4 I '$D(^XUSEC("IMRA",DUZ)) S IMRLOC="IMRPINQ1" D ACESSERR^IMRERR,H^XUS K IMRLOC
5 ; get & display lab test results
6 Q:$G(DFN)'>0 ;quit if dfn not defined
7 ; CD4 or T4 (ACTUAL LEVEL)","ELISA FOR HIV","WESTERN BLOT","VIRAL LOAD"
8 I $Y>(IOSL-4) D PRTC^IMRPINQ Q:IMROUT D HDR^IMRPINQ
9 D ^IMRPLAB
10 I $Y>(IOSL-4) D PRTC^IMRPINQ Q:IMROUT D HDR^IMRPINQ
11 D ^IMRTST
12 I $Y>(IOSL-4) D PRTC^IMRPINQ Q:IMROUT D HDR^IMRPINQ
13 K IMRCD,IMRCNT,IMRLOOP,X
14 Q
15IMMUN ; display immunization data
16 I $Y>(IOSL-4) D PRTC^IMRPINQ Q:IMROUT D HDR^IMRPINQ
17 W !!?29,"***MOST RECENT IMMUNIZATIONS***",!
18 K ^TMP("PXI",$J)
19 S X="PXRHS03" X ^%ZOSF("TEST")
20 I $T D IMMUN^PXRHS03(DFN) ;get immunization data
21 S IMRLOOP=0,(IMRVAC(1),IMRVAC(2))=""
22 F IMRI=1:1:2 S IMRLOOP=$O(^TMP("PXI",$J,"HEP A",IMRLOOP)) Q:'IMRLOOP D
23 .S IMRLOOP(1)=+$O(^TMP("PXI",$J,"HEP A",IMRLOOP,0))
24 .S IMRVAC(IMRI)=$P($G(^TMP("PXI",$J,"HEP A",IMRLOOP,IMRLOOP(1),0)),U,3)
25 .Q
26 I $Y>(IOSL-4) D PRTC^IMRPINQ Q:IMROUT D HDR^IMRPINQ
27 W !?17,"LAST HEPATITIS A: " I IMRVAC(1)>0 W ?35,$$FMTE^XLFDT(IMRVAC(1),"2D")
28 W !?16,"PRIOR HEPATITIS A: " I IMRVAC(2)>0 W ?35,$$FMTE^XLFDT(IMRVAC(2),"2D")
29 S IMRLOOP=0,(IMRVAC(1),IMRVAC(2),IMRVAC(3))=""
30 F IMRI=1:1:3 S IMRLOOP=$O(^TMP("PXI",$J,"HEP B",IMRLOOP)) Q:'IMRLOOP D
31 .S IMRLOOP(1)=+$O(^TMP("PXI",$J,"HEP B",IMRLOOP,0))
32 .S IMRVAC(IMRI)=$P($G(^TMP("PXI",$J,"HEP B",IMRLOOP,IMRLOOP(1),0)),U,3)
33 .Q
34 I $Y>(IOSL-4) D PRTC^IMRPINQ Q:IMROUT D HDR^IMRPINQ
35 W !?17,"LAST HEPATITIS B: " I IMRVAC(1)>0 W ?35,$$FMTE^XLFDT(IMRVAC(1),"2D")
36 W !?16,"PRIOR HEPATITIS B: " I IMRVAC(2)>0 W ?35,$$FMTE^XLFDT(IMRVAC(2),"2D")
37 W !?16,"PRIOR HEPATITIS B: " I IMRVAC(3)>0 W ?35,$$FMTE^XLFDT(IMRVAC(3),"2D")
38 K IMRVAC S IMRVAC=""
39 S IMRLOOP=+$O(^TMP("PXI",$J,"INFLUENZA",0))
40 S IMRLOOP(1)=+$O(^TMP("PXI",$J,"INFLUENZA",IMRLOOP,0))
41 S IMRVAC=$P($G(^TMP("PXI",$J,"INFLUENZA",IMRLOOP,IMRLOOP(1),0)),U,3)
42 I $Y>(IOSL-4) D PRTC^IMRPINQ Q:IMROUT D HDR^IMRPINQ
43 W !?24,"INFLUENZA: " I IMRVAC>0 W ?35,$$FMTE^XLFDT(IMRVAC,"2D")
44 S IMRVAC=""
45 S IMRLOOP=+$O(^TMP("PXI",$J,"TD-ADULT",0))
46 S IMRLOOP(1)=+$O(^TMP("PXI",$J,"TD-ADULT",IMRLOOP,0))
47 S IMRVAC=$P($G(^TMP("PXI",$J,"TD-ADULT",IMRLOOP,IMRLOOP(1),0)),U,3)
48 W !?8,"TETANUS DIPTHERIA (ADULT): " I IMRVAC>0 W ?35,$$FMTE^XLFDT(IMRVAC,"2D")
49 S IMRVAC=""
50 S IMRLOOP=+$O(^TMP("PXI",$J,"PNEUMO-VAC",0))
51 S IMRLOOP(1)=+$O(^TMP("PXI",$J,"PNEUMO-VAC",IMRLOOP,0))
52 S IMRVAC=$P($G(^TMP("PXI",$J,"PNEUMO-VAC",IMRLOOP,IMRLOOP(1),0)),U,3)
53 W !?21,"PNEUMOCOCCAL: " I IMRVAC>0 W ?35,$$FMTE^XLFDT(IMRVAC,"2D")
54 Q
Note: See TracBrowser for help on using the repository browser.