source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSPXIM.m@ 1800

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

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1GMTSPXIM ; SLC/SBW,KER - PCE Immunization component ; 08/27/2002
2 ;;2.7;Health Summary;**8,10,28,56**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 1239 IMMUN^PXRHS03
6 ; DBIA 10011 ^DIWP
7 ;
8IMMUN ; Main Entry Point
9 K ^TMP("PXI",$J) D IMMUN^PXRHS03(DFN) Q:'$D(^TMP("PXI",$J))
10 N GMIMM,GMDT,GMIFN,GMW,GMSITE,GMN0,GMN1,GMSIR,GMSIC,X,GMTSDAT,GML
11 N GMTSX,GMCKP,GMTAB,COMMENT,GMTSLN,GMICL
12 S GMIMM="" D CKP^GMTSUP Q:$D(GMTSQIT) D HDR
13 F S GMIMM=$O(^TMP("PXI",$J,GMIMM)) Q:GMIMM="" D Q:$D(GMTSQIT)
14 . S (GMDT,GMW)=0
15 . F S GMDT=$O(^TMP("PXI",$J,GMIMM,GMDT)) Q:GMDT'>0 D Q:$D(GMTSQIT)
16 . . S GMIFN=0
17 . . F S GMIFN=$O(^TMP("PXI",$J,GMIMM,GMDT,GMIFN)) Q:GMIFN'>0 D IMMDSP Q:$D(GMTSQIT)
18 K ^TMP("PXI",$J)
19 Q
20IMMDSP ; Display Immunization data
21 S DIWL=0,CNT=0,COMMENT="",GMN0=$G(^TMP("PXI",$J,GMIMM,GMDT,GMIFN,0)) Q:GMN0']""
22 S GMN1=$G(^TMP("PXI",$J,GMIMM,GMDT,GMIFN,1))
23 S GMSITE=$S($P(GMN1,U,3)]"":$E($P(GMN1,U,3),1,10),$P(GMN1,U,4)]"":$E($P(GMN1,U,4),1,10),1:"No Site")
24 S X=$P(GMN0,U,3) D REGDT4^GMTSU S GMTSDAT=X
25 S GMSIR=$P(GMN0,U,6),GMSIC=$S(+$P(GMN0,U,7):"DO NOT REPEAT",1:"")
26 I GMSIC]"",GMSIR]"" S GMSIR=GMSIR_"; "
27 S GMSIR=GMSIR_GMSIC
28 D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR I GMW'>0!GMTSNPG W $P(GMN0,U,2) S GML=$L($P(GMN0,U,2))+1
29 W ?16,$P(GMN0,U,4),?23,GMTSDAT,?34,GMSITE
30 I GMSIR']"" W ! G COM
31 I GMSIR]"" S GMICL=47,GMTAB=2,CNT=1 D FORMAT I $D(^UTILITY($J,"W")) D
32 . F GMTSLN=1:1:^UTILITY($J,"W",DIWL) D LINE Q:$D(GMTSQIT)
33COM ; Comments
34 S COMMENT=$P(^TMP("PXI",$J,GMIMM,GMDT,GMIFN,"COM"),U)
35 I COMMENT]"" S GMICL=33,GMTAB=2,CNT=2 D FORMAT I $D(^UTILITY($J,"W")) D CKP^GMTSUP Q:$D(GMTSQIT) D
36 . F GMTSLN=1:1:^UTILITY($J,"W",DIWL) D LINE Q:$D(GMTSQIT)
37 S GMW=1
38 Q
39HDR ; Header
40 W "Immunization",?14,"Series",?25,"Date",?33,"Facility",?47,"Reaction",!!
41 Q
42FORMAT ; Format Line
43 N DIWR,DIWF,X S DIWL=3,DIWR=80-(GMICL+GMTAB) K ^UTILITY($J,"W")
44 S X=$S(CNT=1:GMSIR,CNT=2:COMMENT) D ^DIWP
45 Q
46LINE ; Writes Line
47 D CKP^GMTSUP Q:$D(GMTSQIT)
48 W ?($S(CNT=1:47,CNT=2:33,1:0)),^UTILITY($J,"W",DIWL,GMTSLN,0),!
49 Q
Note: See TracBrowser for help on using the repository browser.