HMPWBIM1 ;;OB/JD/CNP - Write back entry points for IMMUNIZATIONS (related to Notes, and Encounters);Sep 2, 2015@08:31:16
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28
;Per VA Directive 6402, this routine should not be modified.
;
Q
;
IMMUN(RSLT,IEN,DFN,DATA) ; Immunization
;
;RPC: HMP WRITEBACK IMMUNIZATION
;Output
; RSLT = JSON format string for Immunization
;Input
; IEN = record to be updated
; DFN = patient IEN
; DATA - input format - string
; Piece 1: DFN - Patient IEN
; Piece 2: Inpatient flag - 1 = inpatient, 0 = otherwise
; Piece 3: Hospital location IEN
; Piece 4: Visit/episode date
; Piece 5: Service category
; Piece 6: Author/dictator IEN (i.e. Provider)
; Piece 7: (IMM)unization/Encounter type - A 2- or 3-character string as follows:
; CPT for CPT (^AUPNVCPT; #9000010.18)
; HF Health Factor (^AUPNVHF; #9000010.23)
; IMM Immunization (^AUPNVIMM; #9000010.11)
; PED Patient Education (^AUPNVPED; #9000010.16)
; POV POV - Purpose of Visit; a.k.a Diagnosis - (^AUPNVPOV; #9000010.07)
; SK Skin (^AUPNVSK; #9000010.12)
; XAM Exam (^AUPNVXAM; #9000010.13)
; Piece 8: (IMM)unization/Encounter ID - As follows:
; CPT ^ICPT
; HF ^AUTTHF
; IMM ^AUTTIMM
; PED ^AUTTEDT
; POV ^ICD9
; SK ^AUTTSK
; XAM ^AUTTEXAM
; Piece 9: Immunization /Encounter result CODE
; Piece 10: Immunization /Encounter comment number
; Piece 11: Immunization /Encounter comment text
; Piece 12: Reaction
; Piece 13: Repeat ContraIndicated
;
N ERRMSG,JSONERR
I '$G(DFN) D MSG^HMPTOOLS("DFN",1) D ERR(.RSLT) Q ; DFN is required
N ADMNDATE,ENC,ENCNM,ENCNUM,ENCTL,ENCTYP,ENCGLB,ERROR,GLB,HMP,HMPA,HMPFCNT,HMPE
N HMPUID,INFO,LOCALID,LOCALIEN,NOTE,NOTEIEN,OK,ORLOC,PCELIST,PRVNM,STMPTM
S INFO=$G(DATA)
;
;Check for required fields
;
I '$P(INFO,U) D MSG^HMPTOOLS("DFN",1) D ERR(.RSLT) Q ; DFN is required
I $D(^DPT($P(INFO,U)))'>0 D MSG^HMPTOOLS("DFN",2,$P(INFO,U)) D ERR(.RSLT) Q ; Invalid DFN
I '$P(INFO,U,3) D MSG^HMPTOOLS("Location",1) D ERR(.RSLT) Q ; Location is required
I '$P(INFO,U,4) D MSG^HMPTOOLS("Visit",1) D ERR(.RSLT) Q ; Visit is required
I $L($P(INFO,U,5))=0 D MSG^HMPTOOLS("Service category",1) D ERR(.RSLT) Q ; Service category is required
I $L($P(INFO,U,7))=0 D MSG^HMPTOOLS("Immunization Encounter type",1) D ERR(.RSLT) Q ; Immunization /Encounter type is required
;
S DFN=$P(INFO,U),OK="",NOTEIEN=0,ORLOC=$P(INFO,U,3)
S ENCTYP=$$UP^XLFSTR($P(INFO,U,7))
S ENCNUM=$P(INFO,U,8) ; Immunization Code (Number)
S ENCGLB=$S(ENCTYP="CPT":"^ICPT",ENCTYP="POV":"^ICD9",1:"MORE")
I ENCGLB="MORE" S ENCGLB=$S(ENCTYP="PED":"^AUTTEDT",ENCTYP="XAM":"^AUTTEXAM",1:"MORE")
I ENCGLB="MORE" S ENCGLB="^AUTT"_ENCTYP
I $D(@ENCGLB)'>0 D MSG^HMPTOOLS("Immunization Encounter typ",2,ENCTYP) D ERR(.RSLT) Q ; Invalid Immunization /encounter type
S ENCNM=$P($G(@ENCGLB@($P(INFO,U,8),0)),U) ; Immunization /Encounter name
S PRVNM=$P($G(^VA(200,$P(INFO,U,6),0)),U) ; Provider name
;
;Prepare the Immunization /encounter array for the RPC
;
S PCELIST(1)="HDR^"_$P(INFO,U,2)_"^^"_$P(INFO,U,3)_";"_(+$P(INFO,U,4))_";"_$P(INFO,U,5)
S PCELIST(2)="VST^DT^"_(+$P(INFO,U,4))
S PCELIST(3)="VST^PT^"_$P(INFO,U)
S PCELIST(4)="VST^HL^"_$P(INFO,U,3)
S PCELIST(5)="VST^VC^"_$P(INFO,U,5)
S PCELIST(6)="PRV^"_$P(INFO,U,6)_"^^^"_PRVNM_"^1"
S PCELIST(7)=ENCTYP_"+^"_$P(INFO,U,8)_"^^"_ENCNM_U_$P(INFO,U,9)_U_$P(INFO,U,6)_U_$P(INFO,U,12)_U_$P(INFO,U,13)_"^0^"
S PCELIST(7)=PCELIST(7)_$P(INFO,U,10)
S PCELIST(8)="COM^"_$P(INFO,U,10)_U_$S($P(INFO,U,11)]"":$P(INFO,U,11),1:"@")
;
;Invoke the already existing RPC (ORWPCE1 DQSAVE)
;
; Wrap for ORWPCE1 DQSAVE
; Description: This RPC saves immunizations
;
; Input: Parameters are as noted above for this routine, IMMUN^HMPWBIM1.
;
; Output: Immunization parameters for the DQSAVE^ORWPCE1 Broker Call
;
; DFN^IEN^HospitalLocation^VisitDate^Service category^Provider^ImmunizationType^IMM^ImmunizationResultCODE^ImmunizationCommentNumber^ImmunizationCommentText
; Note: IMM Immunization (^AUPNVIMM; #9000010.11) and ^AUTTIMM
;
; Check for duplicates and send a JSON error message if a duplicate IMMUNIZATION is found
S ADMNDATE=+$P(INFO,U,4)
S ERROR=0
S LOCALID="" F S LOCALID=$O(^AUPNVSIT("B",ADMNDATE,LOCALID)) Q:LOCALID="" D
.S LOCALIEN="" F S LOCALIEN=$O(^AUPNVIMM("AD",LOCALID,LOCALIEN)) Q:LOCALIEN="" I $D(^AUPNVIMM(LOCALIEN,0)) I $P(^AUPNVIMM(LOCALIEN,0),"^")=ENCNUM I $P(^AUPNVIMM(LOCALIEN,0),"^",2)=DFN S ERROR=1
I ERROR D MSG^HMPTOOLS("Entry: Immunization already exist for the specified Date and Time for ",2,$P(INFO,U)) D ERR(.RSLT) Q ;
;
; Save/Write IMMUNIZATION to VistA
D DQSAVE^ORWPCE1
;
; Match DFN with the VISIT
S (VISIT,LOCALID)="" F S LOCALID=$O(^AUPNVSIT("B",ADMNDATE,LOCALID)) Q:LOCALID="" D
.S VISIT=LOCALID S LOCALIEN="" F S LOCALIEN=$O(^AUPNVIMM("AD",LOCALID,LOCALIEN)) Q:LOCALIEN="" I $D(^AUPNVIMM(LOCALIEN,0)) I $P(^AUPNVIMM(LOCALIEN,0),"^")=ENCNUM Q:$P(^AUPNVIMM(LOCALIEN,0),"^",2)=DFN
I VISIT>0 D
.K FILTER
.S FILTER("noHead")=1
.S FILTER("patientId")=DFN
.S FILTER("domain")="visit"
.S FILTER("id")=VISIT
.D GET^HMPDJ(.HMP,.FILTER) ; Return JSON visit Data
.S NOTE=$O(^TIU(8925,"V",VISIT,""))
.I NOTE>0 D
..K FILTER
..S FILTER("noHead")=1
..S FILTER("patientId")=DFN
..S FILTER("domain")="document"
..S FILTER("id")=OK ; Return JSON document Data
..D GET^HMPDJ(.HMP,.FILTER)
.S GLB="^AUPNV"_ENCTYP
.S ENC=LOCALIEN ;S ENC=$O(@GLB@("AD",VISIT,"")) ; replaced the code with LOCALIEN variable
.I ENC>0 D ; Get the full domain name so it matches the tags in HMPDJ0
..S ENCTL=$S(ENCTYP="CPT":"cpt",ENCTYP="HF":"factor",ENCTYP="IMM":"immuniza",1:"MORE")
..I ENCTL="MORE" S ENCTL=$S(ENCTYP="PED":"educatio",ENCTYP="POV":"pov",1:"MORE")
..I ENCTL="MORE" S ENCTL=$S(ENCTYP="SK":"skin",ENCTYP="XAM":"exam",1:"")
..K FILTER
..S FILTER("noHead")=1
..S FILTER("patientId")=DFN
..S FILTER("domain")=ENCTL
..S FILTER("id")=ENC
..D GET^HMPDJ(.HMP,.FILTER) ; Return JSON Immunization Data
..;; renmove this ;; line
..S HMPFCNT=0
..S HMPUID=$$SETUID^HMPUTILS(ENCTL,DFN,ENC) ; Build Metastamp and Syncstatus
..S HMPE=$G(^TMP("HMP",$J,1,1))
..S STMPTM=$TR($P($P(HMPE,"stampTime",2),","),""":")
..D ADHOC^HMPUTIL2(ENCTL,HMPFCNT,DFN,HMPUID,STMPTM) ; Removed METASTAMP and SYNCSTART /SYNCSTOP
..S RSLT=$$EXTRACT(HMP)
..K ^TMP("HMPIMM",$J)
..M ^TMP("HMPIMM",$J)=RSLT
..;M ^TMP("HMPIMM",$J)=^TMP("HMP",$J)
..K ^TMP("HMPIMM",$J,"total") ;Stored JSON in HMP WRTIEBACK IMMUNIZATION temporary global for the job/user
..K RSLT
..S RSLT=$NA(^TMP("HMPIMM",$J)) ;Stored location of top level of HMP WRITEBACK JSON in Result variable
Q
;
N HMPSTOP,HMPFND,NULLCHK
S RSLT="",X=0,HMPSTOP=0,HMPFND=0
S (I,J)=0
F S I=$O(^TMP("HMPF",$J,I)) Q:I=""!(HMPSTOP) D
. F S J=$O(^TMP("HMPF",$J,I,J)) Q:J="" D
.. I $G(^TMP("HMPF",$J,I,J))["syncStatus" D
... Q:$P(^TMP("HMPF",$J,I,J),":",1)["domainTotals"
... S RSLT(X)=RSLT(X)_$P(^TMP("HMPF",$J,I,J),",",1)
... S HMPSTOP=1
... Q
.. Q:$D(^TMP("HMPF",$J))=""
.. Q:$G(^TMP("HMPF",$J,I,J))=""
.. Q:$P(^TMP("HMPF",$J,I,J),",",1)'["immuniza"
.. Q:$P(^TMP("HMPF",$J,I,J),",",4)'["localId"
.. Q:$P(^TMP("HMPF",$J,I,J),":",1)["domainTotals"
.. S X=X+1
.. S RSLT(X)=$G(^TMP("HMPF",$J,I,J))
.. F S J=$O(^TMP("HMPF",$J,I,J)) Q:J="" D
... Q:$P(^TMP("HMPF",$J,I,J),":",1)["domainTotals"
... S X=X+1
... S RSLT(X)=$G(^TMP("HMPF",$J,I,J))
... S HMPFND=1
... Q
.. S I=$O(^TMP("HMPF",$J,I))
.. Q
. Q
Q RSLT
ERR(RSLT) ; Display Error
K ^TMP("HMPIMM",$J)
M ^TMP("HMPIMM",$J)=RSLT
K ^TMP("HMPIMM",$J,"total") ;Stored JSON in HMP WRTIEBACK IMMUNIZATION temporary global for the job/user
K RSLT
S RSLT=$NA(^TMP("HMPIMM",$J)) ;Stored location of top level of HMP WRITEBACK JSON in Result variable
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPWBIM1 8298 printed Sep 23, 2025@19:30:48 Page 2
HMPWBIM1 ;;OB/JD/CNP - Write back entry points for IMMUNIZATIONS (related to Notes, and Encounters);Sep 2, 2015@08:31:16
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
IMMUN(RSLT,IEN,DFN,DATA) ; Immunization
+1 ;
+2 ;RPC: HMP WRITEBACK IMMUNIZATION
+3 ;Output
+4 ; RSLT = JSON format string for Immunization
+5 ;Input
+6 ; IEN = record to be updated
+7 ; DFN = patient IEN
+8 ; DATA - input format - string
+9 ; Piece 1: DFN - Patient IEN
+10 ; Piece 2: Inpatient flag - 1 = inpatient, 0 = otherwise
+11 ; Piece 3: Hospital location IEN
+12 ; Piece 4: Visit/episode date
+13 ; Piece 5: Service category
+14 ; Piece 6: Author/dictator IEN (i.e. Provider)
+15 ; Piece 7: (IMM)unization/Encounter type - A 2- or 3-character string as follows:
+16 ; CPT for CPT (^AUPNVCPT; #9000010.18)
+17 ; HF Health Factor (^AUPNVHF; #9000010.23)
+18 ; IMM Immunization (^AUPNVIMM; #9000010.11)
+19 ; PED Patient Education (^AUPNVPED; #9000010.16)
+20 ; POV POV - Purpose of Visit; a.k.a Diagnosis - (^AUPNVPOV; #9000010.07)
+21 ; SK Skin (^AUPNVSK; #9000010.12)
+22 ; XAM Exam (^AUPNVXAM; #9000010.13)
+23 ; Piece 8: (IMM)unization/Encounter ID - As follows:
+24 ; CPT ^ICPT
+25 ; HF ^AUTTHF
+26 ; IMM ^AUTTIMM
+27 ; PED ^AUTTEDT
+28 ; POV ^ICD9
+29 ; SK ^AUTTSK
+30 ; XAM ^AUTTEXAM
+31 ; Piece 9: Immunization /Encounter result CODE
+32 ; Piece 10: Immunization /Encounter comment number
+33 ; Piece 11: Immunization /Encounter comment text
+34 ; Piece 12: Reaction
+35 ; Piece 13: Repeat ContraIndicated
+36 ;
+37 NEW ERRMSG,JSONERR
+38 ; DFN is required
IF '$GET(DFN)
DO MSG^HMPTOOLS("DFN",1)
DO ERR(.RSLT)
QUIT
+39 NEW ADMNDATE,ENC,ENCNM,ENCNUM,ENCTL,ENCTYP,ENCGLB,ERROR,GLB,HMP,HMPA,HMPFCNT,HMPE
+40 NEW HMPUID,INFO,LOCALID,LOCALIEN,NOTE,NOTEIEN,OK,ORLOC,PCELIST,PRVNM,STMPTM
+41 SET INFO=$GET(DATA)
+42 ;
+43 ;Check for required fields
+44 ;
+45 ; DFN is required
IF '$PIECE(INFO,U)
DO MSG^HMPTOOLS("DFN",1)
DO ERR(.RSLT)
QUIT
+46 ; Invalid DFN
IF $DATA(^DPT($PIECE(INFO,U)))'>0
DO MSG^HMPTOOLS("DFN",2,$PIECE(INFO,U))
DO ERR(.RSLT)
QUIT
+47 ; Location is required
IF '$PIECE(INFO,U,3)
DO MSG^HMPTOOLS("Location",1)
DO ERR(.RSLT)
QUIT
+48 ; Visit is required
IF '$PIECE(INFO,U,4)
DO MSG^HMPTOOLS("Visit",1)
DO ERR(.RSLT)
QUIT
+49 ; Service category is required
IF $LENGTH($PIECE(INFO,U,5))=0
DO MSG^HMPTOOLS("Service category",1)
DO ERR(.RSLT)
QUIT
+50 ; Immunization /Encounter type is required
IF $LENGTH($PIECE(INFO,U,7))=0
DO MSG^HMPTOOLS("Immunization Encounter type",1)
DO ERR(.RSLT)
QUIT
+51 ;
+52 SET DFN=$PIECE(INFO,U)
SET OK=""
SET NOTEIEN=0
SET ORLOC=$PIECE(INFO,U,3)
+53 SET ENCTYP=$$UP^XLFSTR($PIECE(INFO,U,7))
+54 ; Immunization Code (Number)
SET ENCNUM=$PIECE(INFO,U,8)
+55 SET ENCGLB=$SELECT(ENCTYP="CPT":"^ICPT",ENCTYP="POV":"^ICD9",1:"MORE")
+56 IF ENCGLB="MORE"
SET ENCGLB=$SELECT(ENCTYP="PED":"^AUTTEDT",ENCTYP="XAM":"^AUTTEXAM",1:"MORE")
+57 IF ENCGLB="MORE"
SET ENCGLB="^AUTT"_ENCTYP
+58 ; Invalid Immunization /encounter type
IF $DATA(@ENCGLB)'>0
DO MSG^HMPTOOLS("Immunization Encounter typ",2,ENCTYP)
DO ERR(.RSLT)
QUIT
+59 ; Immunization /Encounter name
SET ENCNM=$PIECE($GET(@ENCGLB@($PIECE(INFO,U,8),0)),U)
+60 ; Provider name
SET PRVNM=$PIECE($GET(^VA(200,$PIECE(INFO,U,6),0)),U)
+61 ;
+62 ;Prepare the Immunization /encounter array for the RPC
+63 ;
+64 SET PCELIST(1)="HDR^"_$PIECE(INFO,U,2)_"^^"_$PIECE(INFO,U,3)_";"_(+$PIECE(INFO,U,4))_";"_$PIECE(INFO,U,5)
+65 SET PCELIST(2)="VST^DT^"_(+$PIECE(INFO,U,4))
+66 SET PCELIST(3)="VST^PT^"_$PIECE(INFO,U)
+67 SET PCELIST(4)="VST^HL^"_$PIECE(INFO,U,3)
+68 SET PCELIST(5)="VST^VC^"_$PIECE(INFO,U,5)
+69 SET PCELIST(6)="PRV^"_$PIECE(INFO,U,6)_"^^^"_PRVNM_"^1"
+70 SET PCELIST(7)=ENCTYP_"+^"_$PIECE(INFO,U,8)_"^^"_ENCNM_U_$PIECE(INFO,U,9)_U_$PIECE(INFO,U,6)_U_$PIECE(INFO,U,12)_U_$PIECE(INFO,U,13)_"^0^"
+71 SET PCELIST(7)=PCELIST(7)_$PIECE(INFO,U,10)
+72 SET PCELIST(8)="COM^"_$PIECE(INFO,U,10)_U_$SELECT($PIECE(INFO,U,11)]"":$PIECE(INFO,U,11),1:"@")
+73 ;
+74 ;Invoke the already existing RPC (ORWPCE1 DQSAVE)
+75 ;
+76 ; Wrap for ORWPCE1 DQSAVE
+77 ; Description: This RPC saves immunizations
+78 ;
+79 ; Input: Parameters are as noted above for this routine, IMMUN^HMPWBIM1.
+80 ;
+81 ; Output: Immunization parameters for the DQSAVE^ORWPCE1 Broker Call
+82 ;
+83 ; DFN^IEN^HospitalLocation^VisitDate^Service category^Provider^ImmunizationType^IMM^ImmunizationResultCODE^ImmunizationCommentNumber^ImmunizationCommentText
+84 ; Note: IMM Immunization (^AUPNVIMM; #9000010.11) and ^AUTTIMM
+85 ;
+86 ; Check for duplicates and send a JSON error message if a duplicate IMMUNIZATION is found
+87 SET ADMNDATE=+$PIECE(INFO,U,4)
+88 SET ERROR=0
+89 SET LOCALID=""
FOR
SET LOCALID=$ORDER(^AUPNVSIT("B",ADMNDATE,LOCALID))
if LOCALID=""
QUIT
Begin DoDot:1
+90 SET LOCALIEN=""
FOR
SET LOCALIEN=$ORDER(^AUPNVIMM("AD",LOCALID,LOCALIEN))
if LOCALIEN=""
QUIT
IF $DATA(^AUPNVIMM(LOCALIEN,0))
IF $PIECE(^AUPNVIMM(LOCALIEN,0),"^")=ENCNUM
IF $PIECE(^AUPNVIMM(LOCALIEN,0),"^",2)=DFN
SET ERROR=1
End DoDot:1
+91 ;
IF ERROR
DO MSG^HMPTOOLS("Entry: Immunization already exist for the specified Date and Time for ",2,$PIECE(INFO,U))
DO ERR(.RSLT)
QUIT
+92 ;
+93 ; Save/Write IMMUNIZATION to VistA
+94 DO DQSAVE^ORWPCE1
+95 ;
+96 ; Match DFN with the VISIT
+97 SET (VISIT,LOCALID)=""
FOR
SET LOCALID=$ORDER(^AUPNVSIT("B",ADMNDATE,LOCALID))
if LOCALID=""
QUIT
Begin DoDot:1
+98 SET VISIT=LOCALID
SET LOCALIEN=""
FOR
SET LOCALIEN=$ORDER(^AUPNVIMM("AD",LOCALID,LOCALIEN))
if LOCALIEN=""
QUIT
IF $DATA(^AUPNVIMM(LOCALIEN,0))
IF $PIECE(^AUPNVIMM(LOCALIEN,0),"^")=ENCNUM
if $PIECE(^AUPNVIMM(LOCALIEN,0),"^",2)=DFN
QUIT
End DoDot:1
+99 IF VISIT>0
Begin DoDot:1
+100 KILL FILTER
+101 SET FILTER("noHead")=1
+102 SET FILTER("patientId")=DFN
+103 SET FILTER("domain")="visit"
+104 SET FILTER("id")=VISIT
+105 ; Return JSON visit Data
DO GET^HMPDJ(.HMP,.FILTER)
+106 SET NOTE=$ORDER(^TIU(8925,"V",VISIT,""))
+107 IF NOTE>0
Begin DoDot:2
+108 KILL FILTER
+109 SET FILTER("noHead")=1
+110 SET FILTER("patientId")=DFN
+111 SET FILTER("domain")="document"
+112 ; Return JSON document Data
SET FILTER("id")=OK
+113 DO GET^HMPDJ(.HMP,.FILTER)
End DoDot:2
+114 SET GLB="^AUPNV"_ENCTYP
+115 ;S ENC=$O(@GLB@("AD",VISIT,"")) ; replaced the code with LOCALIEN variable
SET ENC=LOCALIEN
+116 ; Get the full domain name so it matches the tags in HMPDJ0
IF ENC>0
Begin DoDot:2
+117 SET ENCTL=$SELECT(ENCTYP="CPT":"cpt",ENCTYP="HF":"factor",ENCTYP="IMM":"immuniza",1:"MORE")
+118 IF ENCTL="MORE"
SET ENCTL=$SELECT(ENCTYP="PED":"educatio",ENCTYP="POV":"pov",1:"MORE")
+119 IF ENCTL="MORE"
SET ENCTL=$SELECT(ENCTYP="SK":"skin",ENCTYP="XAM":"exam",1:"")
+120 KILL FILTER
+121 SET FILTER("noHead")=1
+122 SET FILTER("patientId")=DFN
+123 SET FILTER("domain")=ENCTL
+124 SET FILTER("id")=ENC
+125 ; Return JSON Immunization Data
DO GET^HMPDJ(.HMP,.FILTER)
+126 ;; renmove this ;; line
+127 SET HMPFCNT=0
+128 ; Build Metastamp and Syncstatus
SET HMPUID=$$SETUID^HMPUTILS(ENCTL,DFN,ENC)
+129 SET HMPE=$GET(^TMP("HMP",$JOB,1,1))
+130 SET STMPTM=$TRANSLATE($PIECE($PIECE(HMPE,"stampTime",2),","),""":")
+131 ; Removed METASTAMP and SYNCSTART /SYNCSTOP
DO ADHOC^HMPUTIL2(ENCTL,HMPFCNT,DFN,HMPUID,STMPTM)
+132 SET RSLT=$$EXTRACT(HMP)
+133 KILL ^TMP("HMPIMM",$JOB)
+134 MERGE ^TMP("HMPIMM",$JOB)=RSLT
+135 ;M ^TMP("HMPIMM",$J)=^TMP("HMP",$J)
+136 ;Stored JSON in HMP WRTIEBACK IMMUNIZATION temporary global for the job/user
KILL ^TMP("HMPIMM",$JOB,"total")
+137 KILL RSLT
+138 ;Stored location of top level of HMP WRITEBACK JSON in Result variable
SET RSLT=$NAME(^TMP("HMPIMM",$JOB))
End DoDot:2
End DoDot:1
+139 QUIT
+140 ;
+1 NEW HMPSTOP,HMPFND,NULLCHK
+2 SET RSLT=""
SET X=0
SET HMPSTOP=0
SET HMPFND=0
+3 SET (I,J)=0
+4 FOR
SET I=$ORDER(^TMP("HMPF",$JOB,I))
if I=""!(HMPSTOP)
QUIT
Begin DoDot:1
+5 FOR
SET J=$ORDER(^TMP("HMPF",$JOB,I,J))
if J=""
QUIT
Begin DoDot:2
+6 IF $GET(^TMP("HMPF",$JOB,I,J))["syncStatus"
Begin DoDot:3
+7 if $PIECE(^TMP("HMPF",$JOB,I,J),"
QUIT
+8 SET RSLT(X)=RSLT(X)_$PIECE(^TMP("HMPF",$JOB,I,J),",",1)
+9 SET HMPSTOP=1
+10 QUIT
End DoDot:3
+11 if $DATA(^TMP("HMPF",$JOB))=""
QUIT
+12 if $GET(^TMP("HMPF",$JOB,I,J))=""
QUIT
+13 if $PIECE(^TMP("HMPF",$JOB,I,J),",",1)'["immuniza"
QUIT
+14 if $PIECE(^TMP("HMPF",$JOB,I,J),",",4)'["localId"
QUIT
+15 if $PIECE(^TMP("HMPF",$JOB,I,J),"
QUIT
+16 SET X=X+1
+17 SET RSLT(X)=$GET(^TMP("HMPF",$JOB,I,J))
+18 FOR
SET J=$ORDER(^TMP("HMPF",$JOB,I,J))
if J=""
QUIT
Begin DoDot:3
+19 if $PIECE(^TMP("HMPF",$JOB,I,J),"
QUIT
+20 SET X=X+1
+21 SET RSLT(X)=$GET(^TMP("HMPF",$JOB,I,J))
+22 SET HMPFND=1
+23 QUIT
End DoDot:3
+24 SET I=$ORDER(^TMP("HMPF",$JOB,I))
+25 QUIT
End DoDot:2
+26 QUIT
End DoDot:1
+27 QUIT RSLT
ERR(RSLT) ; Display Error
+1 KILL ^TMP("HMPIMM",$JOB)
+2 MERGE ^TMP("HMPIMM",$JOB)=RSLT
+3 ;Stored JSON in HMP WRTIEBACK IMMUNIZATION temporary global for the job/user
KILL ^TMP("HMPIMM",$JOB,"total")
+4 KILL RSLT
+5 ;Stored location of top level of HMP WRITEBACK JSON in Result variable
SET RSLT=$NAME(^TMP("HMPIMM",$JOB))
+6 QUIT
+7 ;
