GMTSPXIM ;SLC/SBW,KER - PCE Immunization component ;Sep 08, 2023@13:21
;;2.7;Health Summary;**8,10,28,56,89,114,115,144**;Oct 20, 1995;Build 17
;
; Reference to IMMUN^PXRHS03 and CONREF^PXRHS03 in ICR #1239
;
IMMUNCDT ;Main entry point for chron (SIMC)
S GMTSSORT="C" D IMMUN
Q
;
IMMUNRDT ;Main entry point for reverse chron (SIMR)
S GMTSSORT="R" D IMMUN
Q
;
IMMUND ;Main entry point for detailed display (DIM)
N GMTSF
S GMTSF="" ; set flag to display detailed
IMMUN ; Main Entry Point for simple format (IM,SIM)
N GMSX1,GMSX2,GMIFN,GMW,GMSITE,GMN0,GMN1,GMSIR,GMSIC,X,GMTSDAT,CNT
N GMTSX,GMCKP,GMTAB,COMMENT,GMTSLN,GMICL,GMIX,GMTSNPG
N GMTSEDAT,GMFOOTC,GMFOOTR,GMTSTYPE,GMTSCOUNT,GMTSBLANK,GMTSFIRST
I '$D(GMTSSORT) S GMTSSORT="A"
K ^TMP("PXI",$J),^TMP("PXCRI",$J)
D IMMUN^PXRHS03(DFN,GMTSSORT)
D CONREF^PXRHS03(DFN,GMTSSORT)
I '$D(^TMP("PXI",$J)),'$D(^TMP("PXCRI",$J)) Q
S GMTSTYPE="ADMINISTERED"
D SECTHDR
I $D(^TMP("PXI",$J)) D
. I '$D(GMTSF) D HDR Q:$D(GMTSQIT)
. S (GMTSCOUNT,GMTSFIRST)=1
. S GMSX1="" F S GMSX1=$O(^TMP("PXI",$J,GMSX1)) Q:GMSX1="" D Q:$D(GMTSQIT)
. . S GMSX2=""
. . I GMTSFIRST S GMTSFIRST=0,GMTSBLANK=0
. . E S GMTSBLANK=1
. . F S GMSX2=$O(^TMP("PXI",$J,GMSX1,GMSX2)) Q:GMSX2="" D Q:$D(GMTSQIT)
. . . S GMIFN=0
. . . F S GMIFN=$O(^TMP("PXI",$J,GMSX1,GMSX2,GMIFN)) Q:GMIFN'>0 D @($S($D(GMTSF):"IMMDET",1:"IMMDSP")) Q:$D(GMTSQIT)
. . . S GMTSBLANK=0
I '$D(^TMP("PXI",$J)) D
.D CKP^GMTSUP Q:$D(GMTSQIT)
.W !," No data available"
D CKP^GMTSUP Q:$D(GMTSQIT)
I 'GMTSNPG W !
D CKP^GMTSUP Q:$D(GMTSQIT)
I 'GMTSNPG W !
D CONREF("C","CONTRAINDICATED")
D CONREF("R","REFUSED")
I '$D(GMTSF),$D(GMNOTE) D CKP^GMTSUP Q:$D(GMTSQIT) D FOOT(.GMNOTE)
K ^TMP("PXI",$J),^TMP("PXCRI",$J),GMTSSORT
Q
;
IMMDSP ; Display Immunization data
N GMTSNPG
S (GMFOOTR,GMFOOTC)=""
S CNT=0,COMMENT="",GMN0=$G(^TMP("PXI",$J,GMSX1,GMSX2,GMIFN,0)) Q:GMN0']""
S GMN1=$G(^TMP("PXI",$J,GMSX1,GMSX2,GMIFN,1))
S GMSITE=$$GETSITE(GMN1)
S X=$P(GMN0,U,3) D REGDT4^GMTSU S GMTSDAT=X
S GMSIR=$S($P(GMN0,U,6)="NONE":"",1:$P(GMN0,U,6)),GMSIC=$S(+$P(GMN0,U,7):"DO NOT REPEAT",1:"")
I GMSIC]"",GMSIR]"" S GMSIR=$$TRUNCATE(GMSIR,20)_"; "
I GMSIC]""!(GMSIR]"") S GMFOOTR="<**>",GMNOTE("R")=""
S GMSIR=GMSIR_GMSIC
I GMTSBLANK D
.D CKP^GMTSUP Q:$D(GMTSQIT)
.I GMTSNPG D SECTHDR,HDR Q
.W !
; Comments
S COMMENT=$P(^TMP("PXI",$J,GMSX1,GMSX2,GMIFN,"COM"),U)
I COMMENT]"" S GMNOTE("C")="",GMFOOTC="<C>"
D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG SECTHDR,HDR
W !,$$TRUNCATE($P(GMN0,U,1),33)
W ?35,$P(GMN0,U,4),?42,GMTSDAT,?53,$$TRUNCATE(GMSITE,10),?65,GMFOOTR,?74,GMFOOTC
; Footer
I GMFOOTR]"" D
. S GMIX=$S('$D(GMIX):1,1:GMIX+1)
. S GMNOTE("R",GMIX)=$P(GMN0,U,1)_U_GMTSDAT_U_GMSIR
Q
CONREF(GMTSSUB,GMTSTYPE) ; Process contraindications/refusals
N GMTSSUB1,GMTSSUB2,GMTSIFN,GMTSNPG
D SECTHDR
I $D(^TMP("PXCRI",$J,GMTSSUB)) D
.S (GMTSCOUNT,GMTSFIRST)=1
.I '$D(GMTSF) D HDR Q:$D(GMTSQIT)
.S GMTSSUB1="" F S GMTSSUB1=$O(^TMP("PXCRI",$J,GMTSSUB,GMTSSUB1)) Q:GMTSSUB1=""!($D(GMTSQIT)) D
..I GMTSFIRST S GMTSFIRST=0,GMTSBLANK=0
..E S GMTSBLANK=1
..S GMTSSUB2=0 F S GMTSSUB2=$O(^TMP("PXCRI",$J,GMTSSUB,GMTSSUB1,GMTSSUB2)) Q:GMTSSUB2=""!($D(GMTSQIT)) D
...S GMTSIFN=0 F S GMTSIFN=$O(^TMP("PXCRI",$J,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN)) Q:'+GMTSIFN!($D(GMTSQIT)) D
....D @($S($D(GMTSF):"CRDET("""_GMTSSUB_""")",1:"CRDSP("""_GMTSSUB_""")"))
....S GMTSBLANK=0
I '$D(^TMP("PXCRI",$J,GMTSSUB)) D
.D CKP^GMTSUP Q:$D(GMTSQIT)
.W !," No data available"
D CKP^GMTSUP Q:$D(GMTSQIT)!(GMTSNPG)
W !
D CKP^GMTSUP Q:$D(GMTSQIT)!(GMTSNPG)
W !
Q
CRDSP(GMTSSUB) ; Display Contraindicated/Refusal data
N X,GMTSCOM,GMTSN1,GMTSNPG
I GMTSBLANK D
.D CKP^GMTSUP Q:$D(GMTSQIT)
.I GMTSNPG D SECTHDR,HDR Q
.W !
D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG SECTHDR,HDR
W !,$$TRUNCATE($P($G(^TMP("PXCRI",$J,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,0)),U,1),33)
S X=$P($G(^TMP("PXCRI",$J,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,0)),U,2) D REGDT4^GMTSU S GMTSDAT=X
W ?35,X
S GMTSN1=$G(^TMP("PXCRI",$J,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,1))
W ?46,$$TRUNCATE($$GETSITE(GMTSN1),10)
S GMTSCOM=$P(^TMP("PXCRI",$J,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,"COM"),U)
I GMTSCOM'="" W ?58,"<C>" S GMNOTE("C")=""
E W ?58,"<I>" S GMNOTE("I")=""
Q
SECTHDR ; Section Header
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,GMTSTYPE
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,$$REPEAT^XLFSTR("=",$L(GMTSTYPE))
D CKP^GMTSUP Q:$D(GMTSQIT)
W !
I GMTSTYPE'[" (CONT.)" S GMTSTYPE=GMTSTYPE_" (CONT.)"
Q
HDR ; Sub-header
D CKP^GMTSUP Q:$D(GMTSQIT)
I GMTSTYPE["ADMINISTERED" D
.W !,"Immunization",?35,"Series",?42,"Date",?53,"Facility",?65,"Reaction",?74,"Info"
I GMTSTYPE["CONTRAINDICATED"!(GMTSTYPE["REFUSED") D
.W !,"Immunization",?35,"Date",?46,"Facility",?58,"Info"
Q
;
N GMF,GMIX
I $D(GMNOTE("R")) D Q:$D(GMTSQIT)
. S GMIX="" F S GMIX=$O(GMNOTE("R",GMIX)) Q:GMIX=""!($D(GMTSQIT)) D
. . D CKP^GMTSUP Q:$D(GMTSQIT)
. . W !,"<**> ",$$TRUNCATE($P(GMNOTE("R",GMIX),U),23),?30,$P(GMNOTE("R",GMIX),U,2),?42,$P(GMNOTE("R",GMIX),U,3)
I $D(GMNOTE("C")) D Q:$D(GMTSQIT)
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W !,"<C> See the Detailed Immunizations Health Summary Component[DIM] for Comments"
I $D(GMNOTE("I")) D
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W !,"<I> See the Detailed Immunizations Health Summary Component[DIM] for Additional Information"
I $D(GMNOTE("*")) D
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W !," * Value is truncated; see the Detailed Immunizations Health Summary Component[DIM] for"
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W !," complete text"
D CKP^GMTSUP Q:$D(GMTSQIT)
W !
D CKP^GMTSUP Q:$D(GMTSQIT)
W !
K GMNOTE
Q
;
IMMDET ;Main entry point for Detailed format (DIM)
N GMNVIS,PXVI,PXV,GMN2,GMN3,GMN4,GMN0,GMN1,FULLNAME,GMSIR,GMSIC,GMTSRDAT
N GMTSRRDAT,GMTSPART,RCOMMENT,GMTSRESULT,GMTSREADER,GMTSVIS
S GMN0=$G(^TMP("PXI",$J,GMSX1,GMSX2,GMIFN,0)) Q:GMN0']""
S GMN1=$G(^TMP("PXI",$J,GMSX1,GMSX2,GMIFN,1))
S GMN2=$G(^TMP("PXI",$J,GMSX1,GMSX2,GMIFN,2))
S GMN3=$G(^TMP("PXI",$J,GMSX1,GMSX2,GMIFN,3))
S GMN4=$G(^TMP("PXI",$J,GMSX1,GMSX2,GMIFN,4))
S GMSIR=$P(GMN0,U,6),GMSIC=$S(+$P(GMN0,U,7):"DO NOT REPEAT",1:"")
S PXVI="" F S PXVI=$O(^TMP("PXI",$J,GMSX1,GMSX2,GMIFN,"VIS",PXVI)) Q:PXVI'>0 D
. S GMNVIS(PXVI)=^TMP("PXI",$J,GMSX1,GMSX2,GMIFN,"VIS",PXVI)
S GMSITE=$$GETSITE(GMN1)
S X=$P(GMN0,U,3) D REGDT4^GMTSU S GMTSDAT=X
S X=$P($G(GMN3),U,3) D REGDT4^GMTSU S GMTSEDAT=X
S X=$P($G(GMN4),U,3) D REGDT4^GMTSU S GMTSRDAT=X
S X=$P($G(GMN4),U,5) D REGDT4^GMTSU S GMTSRRDAT=X
I GMTSCOUNT>1 D Q:$D(GMTSQIT)
.D CKP^GMTSUP Q:$D(GMTSQIT)
.W !
.D CKP^GMTSUP Q:$D(GMTSQIT)
.W !
D FORMAT^GMTSU($P(GMN0,U),"IMMUNIZATION",2),LINE^GMTSU(2) Q:$D(GMTSQIT)
S GMTSPART=0 F S GMTSPART=$O(^TMP("PXI",$J,GMSX1,GMSX2,GMIFN,"FN",GMTSPART)) Q:'+GMTSPART!($D(GMTSQIT)) D
.D FORMAT^GMTSU(^TMP("PXI",$J,GMSX1,GMSX2,GMIFN,"FN",GMTSPART),$S(GMTSPART=1:"FULL NAME",1:""),2)
D LINE^GMTSU(2) Q:$D(GMTSQIT)
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,?2,"DOSAGE: "_$S($P(GMN2,U,3)="":"",1:$P(GMN2,U,3)),?40,"SERIES: "_$P(GMN0,U,4)
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,?2,"DATE ADMINISTERED: "_GMTSDAT
D FORMAT^GMTSU($P($G(GMN3),U,2),"MANUFACTURER",2),LINE^GMTSU(2) Q:$D(GMTSQIT)
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,?2,"LOT #: "_$P($G(GMN3),U,1),?40,"EXP DATE: "_GMTSEDAT
D FORMAT^GMTSU($P(GMN2,U,1)_" "_$P(GMN2,U,2),"ADMIN ROUTE/SITE",2),LINE^GMTSU(2) Q:$D(GMTSQIT)
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,?2,"REACTION/CONTRAINDICATED: "_GMSIR_$S(GMSIC]"":"; "_GMSIC,1:"")
D FORMAT^GMTSU(GMSITE,"LOCATION",2),LINE^GMTSU(2) Q:$D(GMTSQIT)
S RCOMMENT=$P(^TMP("PXI",$J,GMSX1,GMSX2,GMIFN,"RCOM"),U)
;If any of the reading fields are populated, display all of them
I $$TRIM^XLFSTR($TR(GMN4,"^"," "))'=""!(RCOMMENT'="") D Q:$D(GMTSQIT)
. S GMTSRESULT=$P(GMN4,U,1)
. I $L(GMTSRESULT)>27 D Q:$D(GMTSQIT)
. . D FORMAT^GMTSU(GMTSRESULT,"RESULTS",2),LINE^GMTSU(2) Q:$D(GMTSQIT)
. . D FORMAT^GMTSU($P(GMN4,U,2),"READING",2),LINE^GMTSU(2)
. I $L(GMTSRESULT)<=27 D
. . D CKP^GMTSUP Q:$D(GMTSQIT)
. . W !,?2,"RESULTS: "_GMTSRESULT,?40,"READING: "_$P(GMN4,U,2)
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W !,?2,"DATE READ: "_GMTSRDAT
. S GMTSREADER=$P(GMN4,U,4)
. I $L(GMTSREADER)>32 D Q:$D(GMTSQIT)
. . D FORMAT^GMTSU(GMTSREADER,"READER",2),LINE^GMTSU(2)
. I $L(GMTSREADER)<=32 W ?40,"READER: "_GMTSREADER
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W !,?2,"READING RECORDED: "_GMTSRRDAT,?40,"HOURS READ POST-INOCULATION: "_$P(GMN4,U,6)
. I RCOMMENT="" D Q
. . D CKP^GMTSUP Q:$D(GMTSQIT)
. . W !,?2,"READING COMMENT:"
. D FORMAT^GMTSU(RCOMMENT,"READING COMMENT",2),LINE^GMTSU(2)
I $D(GMNVIS) D Q:$D(GMTSQIT)
. F PXV=0:0 S PXV=$O(GMNVIS(PXV)) Q:PXV=""!($D(GMTSQIT)) D
. . S GMTSVIS=$P(GMNVIS(PXV),U)
. . S X=$P(GMNVIS(PXV),U,2) D REGDT4^GMTSU
. . I $L(GMTSVIS)>30 D
. . . D FORMAT^GMTSU($P(GMNVIS(PXV),U),"VIS",2),LINE^GMTSU(2) Q:$D(GMTSQIT)
. . . D FORMAT^GMTSU(X," EDITION DATE",2),LINE^GMTSU(2)
. . I $L(GMTSVIS)<=30 D
. . . D CKP^GMTSUP Q:$D(GMTSQIT)
. . . W !,?2,"VIS: ",GMTSVIS,?40,"EDITION DATE: "_X
E D CKP^GMTSUP Q:$D(GMTSQIT) W !,?2,"VIS: ",?40,"EDITION DATE:"
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,?2,"ADMINISTERED BY: "_$P(GMN0,U,9)
I $P(GMN0,U,8)'=""!($P(GMN0,U,10)) D
. D CKP^GMTSUP Q:$D(GMTSQIT)
. I $P(GMN0,U,10) D Q
. . W !,?2,"ORDERED BY: POLICY"
. W !,?2,"ORDERED BY: "_$P(GMN0,U,8)
I $P(GMN2,U,4)'="",$P(GMN2,U,4)'=$P(GMN0,U,9) D
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W !,?2,"DOCUMENTED BY: "_$P(GMN2,U,4)
S COMMENT=$P(^TMP("PXI",$J,GMSX1,GMSX2,GMIFN,"COM"),U)
I COMMENT="" D CKP^GMTSUP Q:$D(GMTSQIT) W !,?2,"COMMENTS:"
I COMMENT'="" D FORMAT^GMTSU(COMMENT,"COMMENTS",2),LINE^GMTSU(2) Q:$D(GMTSQIT)
S GMTSCOUNT=GMTSCOUNT+1
Q
CRDET(GMTSSUB) ; Display Contraindicated/Refusal data in detailed format
N GMTSN0,GMTSN1,GMTSPART,GMTSDATE,GMTSCOMMENT,GMTSGNAME,GMTSGROUP,GMTSIMIEN
N GMTSINDENT
S GMTSN0=$G(^TMP("PXCRI",$J,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,0)) Q:GMTSN0=""
S GMTSN1=$G(^TMP("PXCRI",$J,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,1))
I GMTSCOUNT>1 D Q:$D(GMTSQIT)
.D CKP^GMTSUP Q:$D(GMTSQIT)
.W !
.D CKP^GMTSUP Q:$D(GMTSQIT)
.W !
D FORMAT^GMTSU($P(GMTSN0,U,1),"IMMUNIZATION",2),LINE^GMTSU(2) Q:$D(GMTSQIT)
S GMTSPART=0 F S GMTSPART=$O(^TMP("PXCRI",$J,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,"FN",GMTSPART)) Q:'+GMTSPART!($D(GMTSQIT)) D
.D FORMAT^GMTSU(^TMP("PXCRI",$J,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,"FN",GMTSPART),$S(GMTSPART=1:"FULL NAME",1:""),2)
D LINE^GMTSU(2) Q:$D(GMTSQIT)
S X=$P(GMTSN0,U,2) D REGDT4^GMTSU S GMTSDATE=X
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,?2,"DATE "_$S(GMTSSUB="C":"CONTRAINDICATED",1:"REFUSED")_": "_GMTSDATE
D FORMAT^GMTSU($$GETSITE(GMTSN1),"LOCATION",2),LINE^GMTSU(2) Q:$D(GMTSQIT)
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,?2,"REASON: "_$P(GMTSN0,U,4)
I GMTSSUB="C" D
.D CKP^GMTSUP Q:$D(GMTSQIT)
.W !,?4,"TYPE: "_$P(GMTSN0,U,8)
.S GMTSPART=1
.S GMTSIMIEN=0 F S GMTSIMIEN=$O(^TMP("PXCRI",$J,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,"LIMITED",GMTSIMIEN)) Q:'+GMTSIMIEN!($D(GMTSQIT)) D
..I GMTSPART=1 D Q:$D(GMTSQIT)
...D CKP^GMTSUP Q:$D(GMTSQIT)
...W !,?4,"APPLIES TO IMMUNIZATION(S):"
...S GMTSPART=0
..S GMTSINDENT=4
..D FORMAT^GMTSU($G(^TMP("PXCRI",$J,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,"LIMITED",GMTSIMIEN)),"",1),LINE^GMTSU(2)
I GMTSSUB="R" D Q:$D(GMTSQIT)
.D CKP^GMTSUP Q:$D(GMTSQIT)
.W !,?2,"REFUSED VACCINE GROUP: "_$P(GMTSN0,U,6)
.M GMTSGROUP=^TMP("PXCRI",$J,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,"RGROUP")
.I '$D(GMTSGROUP) Q
.S GMTSPART=1
.S GMTSGNAME="" F S GMTSGNAME=$O(GMTSGROUP(GMTSGNAME)) Q:GMTSGNAME=""!($D(GMTSQIT)) D
..I GMTSPART=1 S GMTSPART=" VACCINE GROUP(S)"
..E S GMTSINDENT=20,GMTSPART=""
..D FORMAT^GMTSU(GMTSGNAME,GMTSPART,2),LINE^GMTSU(2)
S GMTSCOMMENT=$P($G(^TMP("PXCRI",$J,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,"COM")),U,1)
I GMTSCOMMENT="" D CKP^GMTSUP Q:$D(GMTSQIT) W !,?2,"COMMENTS:"
I GMTSCOMMENT'="" D FORMAT^GMTSU(GMTSCOMMENT,"COMMENTS",2),LINE^GMTSU(2) Q:$D(GMTSQIT)
S GMTSCOUNT=GMTSCOUNT+1
Q
TRUNCATE(GMTSTEXT,GMTSLEN) ; Truncate the given text to the specified length
N GMTSNEW
S GMTSNEW=GMTSTEXT
I $L(GMTSTEXT)>+GMTSLEN D
.S GMTSNEW=$E(GMTSTEXT,1,(GMTSLEN-1))
.I $E(GMTSNEW,"*")=" " S GMTSNEW=$E(GMTSNEW,1,$L(GMTSNEW)-1)
.S GMTSNEW=GMTSNEW_"*"
I '$D(GMTSF),GMTSNEW["*" S GMNOTE("*")=""
Q GMTSNEW
GETSITE(GMTSNODE) ; Return site name for display
Q $S($P(GMTSNODE,U,3)]"":$P(GMTSNODE,U,3),$P(GMTSNODE,U,4)]"":$P(GMTSNODE,U,4),1:"No Site")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPXIM 12675 printed Sep 15, 2024@21:24:01 Page 2
GMTSPXIM ;SLC/SBW,KER - PCE Immunization component ;Sep 08, 2023@13:21
+1 ;;2.7;Health Summary;**8,10,28,56,89,114,115,144**;Oct 20, 1995;Build 17
+2 ;
+3 ; Reference to IMMUN^PXRHS03 and CONREF^PXRHS03 in ICR #1239
+4 ;
IMMUNCDT ;Main entry point for chron (SIMC)
+1 SET GMTSSORT="C"
DO IMMUN
+2 QUIT
+3 ;
IMMUNRDT ;Main entry point for reverse chron (SIMR)
+1 SET GMTSSORT="R"
DO IMMUN
+2 QUIT
+3 ;
IMMUND ;Main entry point for detailed display (DIM)
+1 NEW GMTSF
+2 ; set flag to display detailed
SET GMTSF=""
IMMUN ; Main Entry Point for simple format (IM,SIM)
+1 NEW GMSX1,GMSX2,GMIFN,GMW,GMSITE,GMN0,GMN1,GMSIR,GMSIC,X,GMTSDAT,CNT
+2 NEW GMTSX,GMCKP,GMTAB,COMMENT,GMTSLN,GMICL,GMIX,GMTSNPG
+3 NEW GMTSEDAT,GMFOOTC,GMFOOTR,GMTSTYPE,GMTSCOUNT,GMTSBLANK,GMTSFIRST
+4 IF '$DATA(GMTSSORT)
SET GMTSSORT="A"
+5 KILL ^TMP("PXI",$JOB),^TMP("PXCRI",$JOB)
+6 DO IMMUN^PXRHS03(DFN,GMTSSORT)
+7 DO CONREF^PXRHS03(DFN,GMTSSORT)
+8 IF '$DATA(^TMP("PXI",$JOB))
IF '$DATA(^TMP("PXCRI",$JOB))
QUIT
+9 SET GMTSTYPE="ADMINISTERED"
+10 DO SECTHDR
+11 IF $DATA(^TMP("PXI",$JOB))
Begin DoDot:1
+12 IF '$DATA(GMTSF)
DO HDR
if $DATA(GMTSQIT)
QUIT
+13 SET (GMTSCOUNT,GMTSFIRST)=1
+14 SET GMSX1=""
FOR
SET GMSX1=$ORDER(^TMP("PXI",$JOB,GMSX1))
if GMSX1=""
QUIT
Begin DoDot:2
+15 SET GMSX2=""
+16 IF GMTSFIRST
SET GMTSFIRST=0
SET GMTSBLANK=0
+17 IF '$TEST
SET GMTSBLANK=1
+18 FOR
SET GMSX2=$ORDER(^TMP("PXI",$JOB,GMSX1,GMSX2))
if GMSX2=""
QUIT
Begin DoDot:3
+19 SET GMIFN=0
+20 FOR
SET GMIFN=$ORDER(^TMP("PXI",$JOB,GMSX1,GMSX2,GMIFN))
if GMIFN'>0
QUIT
DO @($SELECT($DATA(GMTSF):"IMMDET",1:"IMMDSP"))
if $DATA(GMTSQIT)
QUIT
+21 SET GMTSBLANK=0
End DoDot:3
if $DATA(GMTSQIT)
QUIT
End DoDot:2
if $DATA(GMTSQIT)
QUIT
End DoDot:1
+22 IF '$DATA(^TMP("PXI",$JOB))
Begin DoDot:1
+23 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+24 WRITE !," No data available"
End DoDot:1
+25 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+26 IF 'GMTSNPG
WRITE !
+27 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+28 IF 'GMTSNPG
WRITE !
+29 DO CONREF("C","CONTRAINDICATED")
+30 DO CONREF("R","REFUSED")
+31 IF '$DATA(GMTSF)
IF $DATA(GMNOTE)
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
DO FOOT(.GMNOTE)
+32 KILL ^TMP("PXI",$JOB),^TMP("PXCRI",$JOB),GMTSSORT
+33 QUIT
+34 ;
IMMDSP ; Display Immunization data
+1 NEW GMTSNPG
+2 SET (GMFOOTR,GMFOOTC)=""
+3 SET CNT=0
SET COMMENT=""
SET GMN0=$GET(^TMP("PXI",$JOB,GMSX1,GMSX2,GMIFN,0))
if GMN0']""
QUIT
+4 SET GMN1=$GET(^TMP("PXI",$JOB,GMSX1,GMSX2,GMIFN,1))
+5 SET GMSITE=$$GETSITE(GMN1)
+6 SET X=$PIECE(GMN0,U,3)
DO REGDT4^GMTSU
SET GMTSDAT=X
+7 SET GMSIR=$SELECT($PIECE(GMN0,U,6)="NONE":"",1:$PIECE(GMN0,U,6))
SET GMSIC=$SELECT(+$PIECE(GMN0,U,7):"DO NOT REPEAT",1:"")
+8 IF GMSIC]""
IF GMSIR]""
SET GMSIR=$$TRUNCATE(GMSIR,20)_"; "
+9 IF GMSIC]""!(GMSIR]"")
SET GMFOOTR="<**>"
SET GMNOTE("R")=""
+10 SET GMSIR=GMSIR_GMSIC
+11 IF GMTSBLANK
Begin DoDot:1
+12 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+13 IF GMTSNPG
DO SECTHDR
DO HDR
QUIT
+14 WRITE !
End DoDot:1
+15 ; Comments
+16 SET COMMENT=$PIECE(^TMP("PXI",$JOB,GMSX1,GMSX2,GMIFN,"COM"),U)
+17 IF COMMENT]""
SET GMNOTE("C")=""
SET GMFOOTC="<C>"
+18 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO SECTHDR
DO HDR
+19 WRITE !,$$TRUNCATE($PIECE(GMN0,U,1),33)
+20 WRITE ?35,$PIECE(GMN0,U,4),?42,GMTSDAT,?53,$$TRUNCATE(GMSITE,10),?65,GMFOOTR,?74,GMFOOTC
+21 ; Footer
+22 IF GMFOOTR]""
Begin DoDot:1
+23 SET GMIX=$SELECT('$DATA(GMIX):1,1:GMIX+1)
+24 SET GMNOTE("R",GMIX)=$PIECE(GMN0,U,1)_U_GMTSDAT_U_GMSIR
End DoDot:1
+25 QUIT
CONREF(GMTSSUB,GMTSTYPE) ; Process contraindications/refusals
+1 NEW GMTSSUB1,GMTSSUB2,GMTSIFN,GMTSNPG
+2 DO SECTHDR
+3 IF $DATA(^TMP("PXCRI",$JOB,GMTSSUB))
Begin DoDot:1
+4 SET (GMTSCOUNT,GMTSFIRST)=1
+5 IF '$DATA(GMTSF)
DO HDR
if $DATA(GMTSQIT)
QUIT
+6 SET GMTSSUB1=""
FOR
SET GMTSSUB1=$ORDER(^TMP("PXCRI",$JOB,GMTSSUB,GMTSSUB1))
if GMTSSUB1=""!($DATA(GMTSQIT))
QUIT
Begin DoDot:2
+7 IF GMTSFIRST
SET GMTSFIRST=0
SET GMTSBLANK=0
+8 IF '$TEST
SET GMTSBLANK=1
+9 SET GMTSSUB2=0
FOR
SET GMTSSUB2=$ORDER(^TMP("PXCRI",$JOB,GMTSSUB,GMTSSUB1,GMTSSUB2))
if GMTSSUB2=""!($DATA(GMTSQIT))
QUIT
Begin DoDot:3
+10 SET GMTSIFN=0
FOR
SET GMTSIFN=$ORDER(^TMP("PXCRI",$JOB,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN))
if '+GMTSIFN!($DATA(GMTSQIT))
QUIT
Begin DoDot:4
+11 DO @($SELECT($DATA(GMTSF):"CRDET("""_GMTSSUB_""")",1:"CRDSP("""_GMTSSUB_""")"))
+12 SET GMTSBLANK=0
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+13 IF '$DATA(^TMP("PXCRI",$JOB,GMTSSUB))
Begin DoDot:1
+14 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+15 WRITE !," No data available"
End DoDot:1
+16 DO CKP^GMTSUP
if $DATA(GMTSQIT)!(GMTSNPG)
QUIT
+17 WRITE !
+18 DO CKP^GMTSUP
if $DATA(GMTSQIT)!(GMTSNPG)
QUIT
+19 WRITE !
+20 QUIT
CRDSP(GMTSSUB) ; Display Contraindicated/Refusal data
+1 NEW X,GMTSCOM,GMTSN1,GMTSNPG
+2 IF GMTSBLANK
Begin DoDot:1
+3 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+4 IF GMTSNPG
DO SECTHDR
DO HDR
QUIT
+5 WRITE !
End DoDot:1
+6 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO SECTHDR
DO HDR
+7 WRITE !,$$TRUNCATE($PIECE($GET(^TMP("PXCRI",$JOB,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,0)),U,1),33)
+8 SET X=$PIECE($GET(^TMP("PXCRI",$JOB,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,0)),U,2)
DO REGDT4^GMTSU
SET GMTSDAT=X
+9 WRITE ?35,X
+10 SET GMTSN1=$GET(^TMP("PXCRI",$JOB,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,1))
+11 WRITE ?46,$$TRUNCATE($$GETSITE(GMTSN1),10)
+12 SET GMTSCOM=$PIECE(^TMP("PXCRI",$JOB,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,"COM"),U)
+13 IF GMTSCOM'=""
WRITE ?58,"<C>"
SET GMNOTE("C")=""
+14 IF '$TEST
WRITE ?58,"<I>"
SET GMNOTE("I")=""
+15 QUIT
SECTHDR ; Section Header
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+2 WRITE !,GMTSTYPE
+3 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+4 WRITE !,$$REPEAT^XLFSTR("=",$LENGTH(GMTSTYPE))
+5 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+6 WRITE !
+7 IF GMTSTYPE'[" (CONT.)"
SET GMTSTYPE=GMTSTYPE_" (CONT.)"
+8 QUIT
HDR ; Sub-header
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+2 IF GMTSTYPE["ADMINISTERED"
Begin DoDot:1
+3 WRITE !,"Immunization",?35,"Series",?42,"Date",?53,"Facility",?65,"Reaction",?74,"Info"
End DoDot:1
+4 IF GMTSTYPE["CONTRAINDICATED"!(GMTSTYPE["REFUSED")
Begin DoDot:1
+5 WRITE !,"Immunization",?35,"Date",?46,"Facility",?58,"Info"
End DoDot:1
+6 QUIT
+7 ;
+1 NEW GMF,GMIX
+2 IF $DATA(GMNOTE("R"))
Begin DoDot:1
+3 SET GMIX=""
FOR
SET GMIX=$ORDER(GMNOTE("R",GMIX))
if GMIX=""!($DATA(GMTSQIT))
QUIT
Begin DoDot:2
+4 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+5 WRITE !,"<**> ",$$TRUNCATE($PIECE(GMNOTE("R",GMIX),U),23),?30,$PIECE(GMNOTE("R",GMIX),U,2),?42,$PIECE(GMNOTE("R",GMIX),U,3)
End DoDot:2
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+6 IF $DATA(GMNOTE("C"))
Begin DoDot:1
+7 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+8 WRITE !,"<C> See the Detailed Immunizations Health Summary Component[DIM] for Comments"
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+9 IF $DATA(GMNOTE("I"))
Begin DoDot:1
+10 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+11 WRITE !,"<I> See the Detailed Immunizations Health Summary Component[DIM] for Additional Information"
End DoDot:1
+12 IF $DATA(GMNOTE("*"))
Begin DoDot:1
+13 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+14 WRITE !," * Value is truncated; see the Detailed Immunizations Health Summary Component[DIM] for"
+15 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+16 WRITE !," complete text"
End DoDot:1
+17 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+18 WRITE !
+19 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+20 WRITE !
+21 KILL GMNOTE
+22 QUIT
+23 ;
IMMDET ;Main entry point for Detailed format (DIM)
+1 NEW GMNVIS,PXVI,PXV,GMN2,GMN3,GMN4,GMN0,GMN1,FULLNAME,GMSIR,GMSIC,GMTSRDAT
+2 NEW GMTSRRDAT,GMTSPART,RCOMMENT,GMTSRESULT,GMTSREADER,GMTSVIS
+3 SET GMN0=$GET(^TMP("PXI",$JOB,GMSX1,GMSX2,GMIFN,0))
if GMN0']""
QUIT
+4 SET GMN1=$GET(^TMP("PXI",$JOB,GMSX1,GMSX2,GMIFN,1))
+5 SET GMN2=$GET(^TMP("PXI",$JOB,GMSX1,GMSX2,GMIFN,2))
+6 SET GMN3=$GET(^TMP("PXI",$JOB,GMSX1,GMSX2,GMIFN,3))
+7 SET GMN4=$GET(^TMP("PXI",$JOB,GMSX1,GMSX2,GMIFN,4))
+8 SET GMSIR=$PIECE(GMN0,U,6)
SET GMSIC=$SELECT(+$PIECE(GMN0,U,7):"DO NOT REPEAT",1:"")
+9 SET PXVI=""
FOR
SET PXVI=$ORDER(^TMP("PXI",$JOB,GMSX1,GMSX2,GMIFN,"VIS",PXVI))
if PXVI'>0
QUIT
Begin DoDot:1
+10 SET GMNVIS(PXVI)=^TMP("PXI",$JOB,GMSX1,GMSX2,GMIFN,"VIS",PXVI)
End DoDot:1
+11 SET GMSITE=$$GETSITE(GMN1)
+12 SET X=$PIECE(GMN0,U,3)
DO REGDT4^GMTSU
SET GMTSDAT=X
+13 SET X=$PIECE($GET(GMN3),U,3)
DO REGDT4^GMTSU
SET GMTSEDAT=X
+14 SET X=$PIECE($GET(GMN4),U,3)
DO REGDT4^GMTSU
SET GMTSRDAT=X
+15 SET X=$PIECE($GET(GMN4),U,5)
DO REGDT4^GMTSU
SET GMTSRRDAT=X
+16 IF GMTSCOUNT>1
Begin DoDot:1
+17 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+18 WRITE !
+19 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+20 WRITE !
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+21 DO FORMAT^GMTSU($PIECE(GMN0,U),"IMMUNIZATION",2)
DO LINE^GMTSU(2)
if $DATA(GMTSQIT)
QUIT
+22 SET GMTSPART=0
FOR
SET GMTSPART=$ORDER(^TMP("PXI",$JOB,GMSX1,GMSX2,GMIFN,"FN",GMTSPART))
if '+GMTSPART!($DATA(GMTSQIT))
QUIT
Begin DoDot:1
+23 DO FORMAT^GMTSU(^TMP("PXI",$JOB,GMSX1,GMSX2,GMIFN,"FN",GMTSPART),$SELECT(GMTSPART=1:"FULL NAME",1:""),2)
End DoDot:1
+24 DO LINE^GMTSU(2)
if $DATA(GMTSQIT)
QUIT
+25 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+26 WRITE !,?2,"DOSAGE: "_$SELECT($PIECE(GMN2,U,3)="":"",1:$PIECE(GMN2,U,3)),?40,"SERIES: "_$PIECE(GMN0,U,4)
+27 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+28 WRITE !,?2,"DATE ADMINISTERED: "_GMTSDAT
+29 DO FORMAT^GMTSU($PIECE($GET(GMN3),U,2),"MANUFACTURER",2)
DO LINE^GMTSU(2)
if $DATA(GMTSQIT)
QUIT
+30 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+31 WRITE !,?2,"LOT #: "_$PIECE($GET(GMN3),U,1),?40,"EXP DATE: "_GMTSEDAT
+32 DO FORMAT^GMTSU($PIECE(GMN2,U,1)_" "_$PIECE(GMN2,U,2),"ADMIN ROUTE/SITE",2)
DO LINE^GMTSU(2)
if $DATA(GMTSQIT)
QUIT
+33 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+34 WRITE !,?2,"REACTION/CONTRAINDICATED: "_GMSIR_$SELECT(GMSIC]"":"; "_GMSIC,1:"")
+35 DO FORMAT^GMTSU(GMSITE,"LOCATION",2)
DO LINE^GMTSU(2)
if $DATA(GMTSQIT)
QUIT
+36 SET RCOMMENT=$PIECE(^TMP("PXI",$JOB,GMSX1,GMSX2,GMIFN,"RCOM"),U)
+37 ;If any of the reading fields are populated, display all of them
+38 IF $$TRIM^XLFSTR($TRANSLATE(GMN4,"^"," "))'=""!(RCOMMENT'="")
Begin DoDot:1
+39 SET GMTSRESULT=$PIECE(GMN4,U,1)
+40 IF $LENGTH(GMTSRESULT)>27
Begin DoDot:2
+41 DO FORMAT^GMTSU(GMTSRESULT,"RESULTS",2)
DO LINE^GMTSU(2)
if $DATA(GMTSQIT)
QUIT
+42 DO FORMAT^GMTSU($PIECE(GMN4,U,2),"READING",2)
DO LINE^GMTSU(2)
End DoDot:2
if $DATA(GMTSQIT)
QUIT
+43 IF $LENGTH(GMTSRESULT)<=27
Begin DoDot:2
+44 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+45 WRITE !,?2,"RESULTS: "_GMTSRESULT,?40,"READING: "_$PIECE(GMN4,U,2)
End DoDot:2
+46 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+47 WRITE !,?2,"DATE READ: "_GMTSRDAT
+48 SET GMTSREADER=$PIECE(GMN4,U,4)
+49 IF $LENGTH(GMTSREADER)>32
Begin DoDot:2
+50 DO FORMAT^GMTSU(GMTSREADER,"READER",2)
DO LINE^GMTSU(2)
End DoDot:2
if $DATA(GMTSQIT)
QUIT
+51 IF $LENGTH(GMTSREADER)<=32
WRITE ?40,"READER: "_GMTSREADER
+52 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+53 WRITE !,?2,"READING RECORDED: "_GMTSRRDAT,?40,"HOURS READ POST-INOCULATION: "_$PIECE(GMN4,U,6)
+54 IF RCOMMENT=""
Begin DoDot:2
+55 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+56 WRITE !,?2,"READING COMMENT:"
End DoDot:2
QUIT
+57 DO FORMAT^GMTSU(RCOMMENT,"READING COMMENT",2)
DO LINE^GMTSU(2)
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+58 IF $DATA(GMNVIS)
Begin DoDot:1
+59 FOR PXV=0:0
SET PXV=$ORDER(GMNVIS(PXV))
if PXV=""!($DATA(GMTSQIT))
QUIT
Begin DoDot:2
+60 SET GMTSVIS=$PIECE(GMNVIS(PXV),U)
+61 SET X=$PIECE(GMNVIS(PXV),U,2)
DO REGDT4^GMTSU
+62 IF $LENGTH(GMTSVIS)>30
Begin DoDot:3
+63 DO FORMAT^GMTSU($PIECE(GMNVIS(PXV),U),"VIS",2)
DO LINE^GMTSU(2)
if $DATA(GMTSQIT)
QUIT
+64 DO FORMAT^GMTSU(X," EDITION DATE",2)
DO LINE^GMTSU(2)
End DoDot:3
+65 IF $LENGTH(GMTSVIS)<=30
Begin DoDot:3
+66 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+67 WRITE !,?2,"VIS: ",GMTSVIS,?40,"EDITION DATE: "_X
End DoDot:3
End DoDot:2
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+68 IF '$TEST
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE !,?2,"VIS: ",?40,"EDITION DATE:"
+69 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+70 WRITE !,?2,"ADMINISTERED BY: "_$PIECE(GMN0,U,9)
+71 IF $PIECE(GMN0,U,8)'=""!($PIECE(GMN0,U,10))
Begin DoDot:1
+72 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+73 IF $PIECE(GMN0,U,10)
Begin DoDot:2
+74 WRITE !,?2,"ORDERED BY: POLICY"
End DoDot:2
QUIT
+75 WRITE !,?2,"ORDERED BY: "_$PIECE(GMN0,U,8)
End DoDot:1
+76 IF $PIECE(GMN2,U,4)'=""
IF $PIECE(GMN2,U,4)'=$PIECE(GMN0,U,9)
Begin DoDot:1
+77 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+78 WRITE !,?2,"DOCUMENTED BY: "_$PIECE(GMN2,U,4)
End DoDot:1
+79 SET COMMENT=$PIECE(^TMP("PXI",$JOB,GMSX1,GMSX2,GMIFN,"COM"),U)
+80 IF COMMENT=""
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE !,?2,"COMMENTS:"
+81 IF COMMENT'=""
DO FORMAT^GMTSU(COMMENT,"COMMENTS",2)
DO LINE^GMTSU(2)
if $DATA(GMTSQIT)
QUIT
+82 SET GMTSCOUNT=GMTSCOUNT+1
+83 QUIT
CRDET(GMTSSUB) ; Display Contraindicated/Refusal data in detailed format
+1 NEW GMTSN0,GMTSN1,GMTSPART,GMTSDATE,GMTSCOMMENT,GMTSGNAME,GMTSGROUP,GMTSIMIEN
+2 NEW GMTSINDENT
+3 SET GMTSN0=$GET(^TMP("PXCRI",$JOB,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,0))
if GMTSN0=""
QUIT
+4 SET GMTSN1=$GET(^TMP("PXCRI",$JOB,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,1))
+5 IF GMTSCOUNT>1
Begin DoDot:1
+6 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+7 WRITE !
+8 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+9 WRITE !
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+10 DO FORMAT^GMTSU($PIECE(GMTSN0,U,1),"IMMUNIZATION",2)
DO LINE^GMTSU(2)
if $DATA(GMTSQIT)
QUIT
+11 SET GMTSPART=0
FOR
SET GMTSPART=$ORDER(^TMP("PXCRI",$JOB,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,"FN",GMTSPART))
if '+GMTSPART!($DATA(GMTSQIT))
QUIT
Begin DoDot:1
+12 DO FORMAT^GMTSU(^TMP("PXCRI",$JOB,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,"FN",GMTSPART),$SELECT(GMTSPART=1:"FULL NAME",1:""),2)
End DoDot:1
+13 DO LINE^GMTSU(2)
if $DATA(GMTSQIT)
QUIT
+14 SET X=$PIECE(GMTSN0,U,2)
DO REGDT4^GMTSU
SET GMTSDATE=X
+15 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+16 WRITE !,?2,"DATE "_$SELECT(GMTSSUB="C":"CONTRAINDICATED",1:"REFUSED")_": "_GMTSDATE
+17 DO FORMAT^GMTSU($$GETSITE(GMTSN1),"LOCATION",2)
DO LINE^GMTSU(2)
if $DATA(GMTSQIT)
QUIT
+18 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+19 WRITE !,?2,"REASON: "_$PIECE(GMTSN0,U,4)
+20 IF GMTSSUB="C"
Begin DoDot:1
+21 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+22 WRITE !,?4,"TYPE: "_$PIECE(GMTSN0,U,8)
+23 SET GMTSPART=1
+24 SET GMTSIMIEN=0
FOR
SET GMTSIMIEN=$ORDER(^TMP("PXCRI",$JOB,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,"LIMITED",GMTSIMIEN))
if '+GMTSIMIEN!($DATA(GMTSQIT))
QUIT
Begin DoDot:2
+25 IF GMTSPART=1
Begin DoDot:3
+26 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+27 WRITE !,?4,"APPLIES TO IMMUNIZATION(S):"
+28 SET GMTSPART=0
End DoDot:3
if $DATA(GMTSQIT)
QUIT
+29 SET GMTSINDENT=4
+30 DO FORMAT^GMTSU($GET(^TMP("PXCRI",$JOB,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,"LIMITED",GMTSIMIEN)),"",1)
DO LINE^GMTSU(2)
End DoDot:2
End DoDot:1
+31 IF GMTSSUB="R"
Begin DoDot:1
+32 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+33 WRITE !,?2,"REFUSED VACCINE GROUP: "_$PIECE(GMTSN0,U,6)
+34 MERGE GMTSGROUP=^TMP("PXCRI",$JOB,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,"RGROUP")
+35 IF '$DATA(GMTSGROUP)
QUIT
+36 SET GMTSPART=1
+37 SET GMTSGNAME=""
FOR
SET GMTSGNAME=$ORDER(GMTSGROUP(GMTSGNAME))
if GMTSGNAME=""!($DATA(GMTSQIT))
QUIT
Begin DoDot:2
+38 IF GMTSPART=1
SET GMTSPART=" VACCINE GROUP(S)"
+39 IF '$TEST
SET GMTSINDENT=20
SET GMTSPART=""
+40 DO FORMAT^GMTSU(GMTSGNAME,GMTSPART,2)
DO LINE^GMTSU(2)
End DoDot:2
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+41 SET GMTSCOMMENT=$PIECE($GET(^TMP("PXCRI",$JOB,GMTSSUB,GMTSSUB1,GMTSSUB2,GMTSIFN,"COM")),U,1)
+42 IF GMTSCOMMENT=""
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE !,?2,"COMMENTS:"
+43 IF GMTSCOMMENT'=""
DO FORMAT^GMTSU(GMTSCOMMENT,"COMMENTS",2)
DO LINE^GMTSU(2)
if $DATA(GMTSQIT)
QUIT
+44 SET GMTSCOUNT=GMTSCOUNT+1
+45 QUIT
TRUNCATE(GMTSTEXT,GMTSLEN) ; Truncate the given text to the specified length
+1 NEW GMTSNEW
+2 SET GMTSNEW=GMTSTEXT
+3 IF $LENGTH(GMTSTEXT)>+GMTSLEN
Begin DoDot:1
+4 SET GMTSNEW=$EXTRACT(GMTSTEXT,1,(GMTSLEN-1))
+5 IF $EXTRACT(GMTSNEW,"*")=" "
SET GMTSNEW=$EXTRACT(GMTSNEW,1,$LENGTH(GMTSNEW)-1)
+6 SET GMTSNEW=GMTSNEW_"*"
End DoDot:1
+7 IF '$DATA(GMTSF)
IF GMTSNEW["*"
SET GMNOTE("*")=""
+8 QUIT GMTSNEW
GETSITE(GMTSNODE) ; Return site name for display
+1 QUIT $SELECT($PIECE(GMTSNODE,U,3)]"":$PIECE(GMTSNODE,U,3),$PIECE(GMTSNODE,U,4)]"":$PIECE(GMTSNODE,U,4),1:"No Site")
