PXVRPC6 ;SLC/AGP - PCE RPCs for generating IMM Note Text ;04/06/16 15:10
;;1.0;PCE PATIENT CARE ENCOUNTER;**215**;Aug 12, 1996;Build 10
;
;
GETTEXT(OUTPUT,INPUT) ;
;
; This RPC takes an input array of immunization properties set from the GUI.
; It returns a formatted text of an immunization for use in documentation.
;
;Input:
; INPUT(x)=IMM ^ Imm IEN ^ ^ Date Administered (for immunizations) / Date Contra-Refusal Event Documented
; (for contra/refusals) ^ Warn Until Date (for contra/refusals) ^ Series ^ Refusal reason ^
; Contraindication Reason ^ Ordered By ^ Administered By (for VA administered) / Documented By
; (for historical) ^ Document Type ("Historical"/"Administered") ^ Information Source
; INPUT(x)=LOC ^ File #44 IEN ^ ^ ^ Outside Location (for historicals)
; INPUT(x)=ROUTE ^ Route ^ Site ^ Dosage
; INPUT(x)=VIS ^ VIS Name ^ Edition Date ^ Language
; INPUT(x)=LOT ^ Lot # ^ Manufacturer ^ Exp Date
; INPUT(x)=COM ^ Comment
; INPUT(x)=OVER ^ Override Reason
;
;Returns:
; Formatted text of an immunization for use in documentation.
;
N ARRAY,COMMENT,DOCTYPE,I,IMM,J,NODE,OVERRIDE,TEMP,VISCNT,X0,XLOC,XLOT,XROUTE
S (X0,XROUTE,XLOC,XLOT,COMMENT,OVERRIDE)=""
S VISCNT=0
S I=0
F S I=$O(INPUT(I)) Q:I'>0 D
. S NODE=$G(INPUT(I))
. I $P(NODE,U)="IMM" S X0=$P(NODE,U,2,99) Q
. I $P(NODE,U)="LOC" S XLOC=$P(NODE,U,2,99) Q
. I $P(NODE,U)="ROUTE" S XROUTE=$P(NODE,U,2,4) Q
. I $P(NODE,U)="VIS" S VISCNT=VISCNT+1,ARRAY("VIS",VISCNT)=$P(NODE,U,2,99) Q
. I $P(NODE,U)="LOT" S XLOT=$P(NODE,U,2,99) Q
. I $P(NODE,U)="COM" S COMMENT=$P(NODE,U,2) Q
. I $P(NODE,U)="OVER" S OVERRIDE=$P(NODE,U,2) Q
;
S I=0
;
S IMM=$P(X0,U,1)
I 'IMM S OUTPUT(I)="" Q
S I=I+1
S OUTPUT(I)="IMMUNIZATION: "_$P($G(^AUTTIMM(IMM,0)),U,1)
S J=0 F S J=$O(^AUTTIMM(IMM,2,J)) Q:'J D
. S I=I+1
. S OUTPUT(I)=$S(I=2:"FULL NAME: ",1:"")_$G(^AUTTIMM(IMM,2,J,0))
;
S DOCTYPE=$P(X0,U,10)
;
;contraindacted or refused
I $P(X0,U,6)'=""!($P(X0,U,7)'="") D Q
. I $P(X0,U,6)'="" S I=I+1,OUTPUT(I)="REFUSAL REASON: "_$P(X0,U,6)
. I $P(X0,U,7)'="" S I=I+1,OUTPUT(I)="CONTRAINDICATION REASON: "_$P(X0,U,7)
. I +$P(X0,U,4)>0 S I=I+1,OUTPUT(I)="WARN UNTIL: "_$TR($$FMTE^XLFDT($P(X0,U,4),"2ZM"),"@"," ")
. I COMMENT'="" S I=I+1,OUTPUT(I)="COMMENT: "_COMMENT
. S I=I+1,OUTPUT(I)="Date Documented: "_$TR($$FMTE^XLFDT($P(X0,U,3),"2ZM"),"@"," ")
;
;determine label depending on admin vs historical
S TEMP=$S(DOCTYPE="Historical":"HISTORICAL DATE ADMINISTERED",1:"DATE ADMINISTERED")_": "_$TR($$FMTE^XLFDT($P(X0,U,3),"2ZM"),"@"," ")
S I=I+1,OUTPUT(I)=$$LJ^XLFSTR(TEMP,60)
I $P(X0,U,5)'="" S OUTPUT(I)=OUTPUT(I)_"SERIES: "_$P(X0,U,5)
I $P(XLOT,U,2)'="" S I=I+1,OUTPUT(I)="MANUFACTURER: "_$P(XLOT,U,2)
I $P(XLOT,U)'="" S I=I+1,OUTPUT(I)=$$LJ^XLFSTR("LOT: "_$P(XLOT,U),60)_"EXP DATE: "_$S($P(XLOT,U,3)'="":$P(XLOT,U,3),1:"Unknown")
;determine label depending on admin vs historical
S TEMP=$S($P(XLOC,U)>0:"LOCATION: "_$P($G(^SC($P(XLOC,U),0)),U),$P(XLOC,U,4)'="":"OUTSIDE LOCATION: "_$P(XLOC,U,4),1:"")
I TEMP'=""!($P(XROUTE,U,3)'="") D
. S I=I+1,OUTPUT(I)=$$LJ^XLFSTR(TEMP,60)
. I $P(XROUTE,U,3)'="" S OUTPUT(I)=OUTPUT(I)_"DOSAGE: "_$P(XROUTE,U,3)
I $P(XROUTE,U)'="" S I=I+1,OUTPUT(I)="ADMIN ROUTE/SITE: "_$P(XROUTE,U)_"/"_$P(XROUTE,U,2)
I $P(X0,U,11)'="" S I=I+1,OUTPUT(I)="INFORMATION SOURCE: "_$P(X0,U,11)
I $D(ARRAY("VIS")) D
. S I=I+1
. S OUTPUT(I)="Vaccine Information Statement(s):"
. S VISCNT=0 F S VISCNT=$O(ARRAY("VIS",VISCNT)) Q:VISCNT'>0 D
. . S NODE=$G(ARRAY("VIS",VISCNT))
. . S I=I+1
. . S OUTPUT(I)="VIS Name: "_$P(NODE,U)_", Edition Date: "_$TR($$FMTE^XLFDT($P(NODE,U,2),"2ZM"),"@"," ")_", Language: "_$P(NODE,U,3)
I $P(X0,U,8)'="" S I=I+1,OUTPUT(I)="ORDERED BY: "_$P(X0,U,8)
I $P(X0,U,9)'="" D
. I DOCTYPE="Administered" S I=I+1,OUTPUT(I)="ADMINISTERED BY: "_$P(X0,U,9) Q
. S I=I+1,OUTPUT(I)="DOCUMENTED BY: "_$P(X0,U,9)
I COMMENT'="" S I=I+1,OUTPUT(I)="COMMENT: "_COMMENT
I OVERRIDE'="" S I=I+1,OUTPUT(I)="OVERRIDE REASON: "_OVERRIDE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVRPC6 4133 printed Sep 23, 2025@20:08:04 Page 2
PXVRPC6 ;SLC/AGP - PCE RPCs for generating IMM Note Text ;04/06/16 15:10
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**215**;Aug 12, 1996;Build 10
+2 ;
+3 ;
GETTEXT(OUTPUT,INPUT) ;
+1 ;
+2 ; This RPC takes an input array of immunization properties set from the GUI.
+3 ; It returns a formatted text of an immunization for use in documentation.
+4 ;
+5 ;Input:
+6 ; INPUT(x)=IMM ^ Imm IEN ^ ^ Date Administered (for immunizations) / Date Contra-Refusal Event Documented
+7 ; (for contra/refusals) ^ Warn Until Date (for contra/refusals) ^ Series ^ Refusal reason ^
+8 ; Contraindication Reason ^ Ordered By ^ Administered By (for VA administered) / Documented By
+9 ; (for historical) ^ Document Type ("Historical"/"Administered") ^ Information Source
+10 ; INPUT(x)=LOC ^ File #44 IEN ^ ^ ^ Outside Location (for historicals)
+11 ; INPUT(x)=ROUTE ^ Route ^ Site ^ Dosage
+12 ; INPUT(x)=VIS ^ VIS Name ^ Edition Date ^ Language
+13 ; INPUT(x)=LOT ^ Lot # ^ Manufacturer ^ Exp Date
+14 ; INPUT(x)=COM ^ Comment
+15 ; INPUT(x)=OVER ^ Override Reason
+16 ;
+17 ;Returns:
+18 ; Formatted text of an immunization for use in documentation.
+19 ;
+20 NEW ARRAY,COMMENT,DOCTYPE,I,IMM,J,NODE,OVERRIDE,TEMP,VISCNT,X0,XLOC,XLOT,XROUTE
+21 SET (X0,XROUTE,XLOC,XLOT,COMMENT,OVERRIDE)=""
+22 SET VISCNT=0
+23 SET I=0
+24 FOR
SET I=$ORDER(INPUT(I))
if I'>0
QUIT
Begin DoDot:1
+25 SET NODE=$GET(INPUT(I))
+26 IF $PIECE(NODE,U)="IMM"
SET X0=$PIECE(NODE,U,2,99)
QUIT
+27 IF $PIECE(NODE,U)="LOC"
SET XLOC=$PIECE(NODE,U,2,99)
QUIT
+28 IF $PIECE(NODE,U)="ROUTE"
SET XROUTE=$PIECE(NODE,U,2,4)
QUIT
+29 IF $PIECE(NODE,U)="VIS"
SET VISCNT=VISCNT+1
SET ARRAY("VIS",VISCNT)=$PIECE(NODE,U,2,99)
QUIT
+30 IF $PIECE(NODE,U)="LOT"
SET XLOT=$PIECE(NODE,U,2,99)
QUIT
+31 IF $PIECE(NODE,U)="COM"
SET COMMENT=$PIECE(NODE,U,2)
QUIT
+32 IF $PIECE(NODE,U)="OVER"
SET OVERRIDE=$PIECE(NODE,U,2)
QUIT
End DoDot:1
+33 ;
+34 SET I=0
+35 ;
+36 SET IMM=$PIECE(X0,U,1)
+37 IF 'IMM
SET OUTPUT(I)=""
QUIT
+38 SET I=I+1
+39 SET OUTPUT(I)="IMMUNIZATION: "_$PIECE($GET(^AUTTIMM(IMM,0)),U,1)
+40 SET J=0
FOR
SET J=$ORDER(^AUTTIMM(IMM,2,J))
if 'J
QUIT
Begin DoDot:1
+41 SET I=I+1
+42 SET OUTPUT(I)=$SELECT(I=2:"FULL NAME: ",1:"")_$GET(^AUTTIMM(IMM,2,J,0))
End DoDot:1
+43 ;
+44 SET DOCTYPE=$PIECE(X0,U,10)
+45 ;
+46 ;contraindacted or refused
+47 IF $PIECE(X0,U,6)'=""!($PIECE(X0,U,7)'="")
Begin DoDot:1
+48 IF $PIECE(X0,U,6)'=""
SET I=I+1
SET OUTPUT(I)="REFUSAL REASON: "_$PIECE(X0,U,6)
+49 IF $PIECE(X0,U,7)'=""
SET I=I+1
SET OUTPUT(I)="CONTRAINDICATION REASON: "_$PIECE(X0,U,7)
+50 IF +$PIECE(X0,U,4)>0
SET I=I+1
SET OUTPUT(I)="WARN UNTIL: "_$TRANSLATE($$FMTE^XLFDT($PIECE(X0,U,4),"2ZM"),"@"," ")
+51 IF COMMENT'=""
SET I=I+1
SET OUTPUT(I)="COMMENT: "_COMMENT
+52 SET I=I+1
SET OUTPUT(I)="Date Documented: "_$TRANSLATE($$FMTE^XLFDT($PIECE(X0,U,3),"2ZM"),"@"," ")
End DoDot:1
QUIT
+53 ;
+54 ;determine label depending on admin vs historical
+55 SET TEMP=$SELECT(DOCTYPE="Historical":"HISTORICAL DATE ADMINISTERED",1:"DATE ADMINISTERED")_": "_$TRANSLATE($$FMTE^XLFDT($PIECE(X0,U,3),"2ZM"),"@"," ")
+56 SET I=I+1
SET OUTPUT(I)=$$LJ^XLFSTR(TEMP,60)
+57 IF $PIECE(X0,U,5)'=""
SET OUTPUT(I)=OUTPUT(I)_"SERIES: "_$PIECE(X0,U,5)
+58 IF $PIECE(XLOT,U,2)'=""
SET I=I+1
SET OUTPUT(I)="MANUFACTURER: "_$PIECE(XLOT,U,2)
+59 IF $PIECE(XLOT,U)'=""
SET I=I+1
SET OUTPUT(I)=$$LJ^XLFSTR("LOT: "_$PIECE(XLOT,U),60)_"EXP DATE: "_$SELECT($PIECE(XLOT,U,3)'="":$PIECE(XLOT,U,3),1:"Unknown")
+60 ;determine label depending on admin vs historical
+61 SET TEMP=$SELECT($PIECE(XLOC,U)>0:"LOCATION: "_$PIECE($GET(^SC($PIECE(XLOC,U),0)),U),$PIECE(XLOC,U,4)'="":"OUTSIDE LOCATION: "_$PIECE(XLOC,U,4),1:"")
+62 IF TEMP'=""!($PIECE(XROUTE,U,3)'="")
Begin DoDot:1
+63 SET I=I+1
SET OUTPUT(I)=$$LJ^XLFSTR(TEMP,60)
+64 IF $PIECE(XROUTE,U,3)'=""
SET OUTPUT(I)=OUTPUT(I)_"DOSAGE: "_$PIECE(XROUTE,U,3)
End DoDot:1
+65 IF $PIECE(XROUTE,U)'=""
SET I=I+1
SET OUTPUT(I)="ADMIN ROUTE/SITE: "_$PIECE(XROUTE,U)_"/"_$PIECE(XROUTE,U,2)
+66 IF $PIECE(X0,U,11)'=""
SET I=I+1
SET OUTPUT(I)="INFORMATION SOURCE: "_$PIECE(X0,U,11)
+67 IF $DATA(ARRAY("VIS"))
Begin DoDot:1
+68 SET I=I+1
+69 SET OUTPUT(I)="Vaccine Information Statement(s):"
+70 SET VISCNT=0
FOR
SET VISCNT=$ORDER(ARRAY("VIS",VISCNT))
if VISCNT'>0
QUIT
Begin DoDot:2
+71 SET NODE=$GET(ARRAY("VIS",VISCNT))
+72 SET I=I+1
+73 SET OUTPUT(I)="VIS Name: "_$PIECE(NODE,U)_", Edition Date: "_$TRANSLATE($$FMTE^XLFDT($PIECE(NODE,U,2),"2ZM"),"@"," ")_", Language: "_$PIECE(NODE,U,3)
End DoDot:2
End DoDot:1
+74 IF $PIECE(X0,U,8)'=""
SET I=I+1
SET OUTPUT(I)="ORDERED BY: "_$PIECE(X0,U,8)
+75 IF $PIECE(X0,U,9)'=""
Begin DoDot:1
+76 IF DOCTYPE="Administered"
SET I=I+1
SET OUTPUT(I)="ADMINISTERED BY: "_$PIECE(X0,U,9)
QUIT
+77 SET I=I+1
SET OUTPUT(I)="DOCUMENTED BY: "_$PIECE(X0,U,9)
End DoDot:1
+78 IF COMMENT'=""
SET I=I+1
SET OUTPUT(I)="COMMENT: "_COMMENT
+79 IF OVERRIDE'=""
SET I=I+1
SET OUTPUT(I)="OVERRIDE REASON: "_OVERRIDE
+80 QUIT
