HMPWB1 ; Agilex/EJK/JD - WRITE BACK ACTIVITY;Nov 5, 2015@16:15:08
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2,3**;Sep 01, 2011;Build 15
;Per VA Directive 6402, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; EDITSAVE^ORWDAL32 6427
;
Q
; allergy write back from eHMP-UI to VistA
ALLERGY(RSLT,IEN,DFN,DATA) ;file allergy data
; RSLT - result, passed by reference
; IEN - zero for new allergy, or IEN for edit
; DFN - patient identifier
; DATA - array of allergy data. Subscript names are required.
; ("GMRACHT",0)=1 - Chart Marked indicator
; ("GMRACHT",1)=3150603.0905 - Date/Time Chart Marked
; ("GMRAGNT")="DIGITOXIN^9;PSNDF(50.6," - Allergy and Pointer to Allergen File
; ("GMRAOBHX")="o^OBSERVED" - (O)bserved or (H)istorical
; ("GMRAORIG")=10000000224 - Pointer to VA DRUG CLASS File (50.605)
; ("GMRAORDT")=3150603.0805 - Allergy assessmant date and time.
; ("GMRASEVR")=2 - Severity of Allergy. 1=Mild, 2=Moderate, 3=Severe
; ("GMRATYPE")="D^Drug" - Type of Allergen (F)ood or (D)rug
; ("GMRANATR")="A^Allergy" - Mechanism of Allergy (A)llergy, (P)harmacologic, (U)nknown.
; ("GMRASYMP",0)=2 - Number of Symptoms
; ("GMRASYMP",1)="2^ITCHING,WATERING EYES" - IEN and Description of Symptom 1
; ("GMRASYMP",2)="133^RASH" - IEN and Description of Symptom 2
;
I $G(DFN)'>0 D MSG^HMPTOOLS("DFN",1) Q
I '$D(DATA) D MSG^HMPTOOLS("DATA Array",1) Q
N CMMT,FILTER,GMR0,GMRA,GMR0,GMRIEN,HMPALRGY,HMPDATA,HMPDFN,HMPSITE,I,ORY,REAC,STMPTM,USER,VPRI,X,XWBOS,Y
N HMPIDX,HMPSTOP,HMPDFN
S HMPSTOP=0
;
N $ES,$ET,ERRPAT,ERRMSG,D0
S HMPDFN=DFN
S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
S ERRMSG="A problem occurred in the allergy domain, routine: "_$T(+0)
S XWBOS=$$NOW^XLFDT ; indicate that we're in the RPC broker, prevent interactive calls
;DE6629 - PB - Sep 7, 2016 - check DATA("GMRAGNT" and strip out all but the file root.
I $P(DATA("GMRAGNT"),",",2)'="" N GMR1 S GMR1=$P(DATA("GMRAGNT"),",",1),DATA("GMRAGNT")=$P(GMR1,";",2)_","
L +^GMR(120.8,0):5
D EDITSAVE^ORWDAL32(.ORY,IEN,DFN,.DATA) ; update ADVERSE REACTION ASSESSMENT (#120.86)
; ejk US3232 if failure to file, send error message as result.
L -^GMR(120.8,0)
I $P(ORY,"^",1)=-1 D MSG^HMPTOOLS($P(ORY,"^",2)) D ERROR Q
I $P(ORY,U,1)=0,'$D(D0) D
. S HMPSTOP=0,HMPIDX=""
. F S HMPIDX=$O(^GMR(120.8,"B",DFN,HMPIDX),-1) Q:HMPIDX=""!(HMPSTOP=1) D
.. S GMR0=$G(^GMR(120.8,HMPIDX,0))
.. I $P(GMR0,U,1)=HMPDFN,$P(GMR0,U,2)=$P(DATA("GMRAGNT"),U,1) S D0=HMPIDX,DFN=HMPDFN,HMPSTOP=1
.. Q
. Q
I HMPSTOP S D0=HMPIDX,DFN=HMPDFN
; return value in RSLT
S HMP=$NA(^TMP("HMP",$J)) K @HMP
S FILTER("id")=D0 ;ien for the entry into the allergy file
S FILTER("patientId")=DFN ;patient identifier
S FILTER("domain")="allergy" ;domain name for write back and freshness stream staging
S FILTER("noHead")=1 ;no header record required.
D GET^HMPDJ(.RSLT,.FILTER) ;build the JSON array in the ^TMP global
K ^TMP("ALLERGY",$J)
M ^TMP("ALLERGY",$J)=@RSLT
S RSLT=$NA(^TMP("ALLERGY",$J))
S HMPFCNT=0
S HMPUID=$$SETUID^HMPUTILS("allergy",DFN,D0)
S HMPE=^TMP("ALLERGY",$J,1,1)
S STMPTM=$TR($P($P(HMPE,"lastUpdateTime",2),","),""":")
D ADHOC^HMPUTIL2("allergy",HMPFCNT,DFN,HMPUID,STMPTM)
K RSLT
S RSLT=$$EXTRACT(HMP)
M ^TMP("HMPALL",$J)=RSLT
K RSLT
S RSLT=$NA(^TMP("HMPALL",$J))
;Clear work files
K @HMP
Q
;
ALLEIE(RSLT,DATA) ;file allergy entered in error
;Since DFN is not relevant as an input parameter, we removed it from the DATA string
;Once we know the allergy IEN, DFN will also be known. JD - 11/5/15.
; RSLT - result, passed by reference
; DATA - contains all information needed to mark a Allergy as Entered in Error
; IEN^GMRAERR^GMRAERRBY^GMRAERRDT^GMRACMTS,0)^GMRACMTS,1)
; IEN = Pointer to the Allergy to be marked as Entered in Error
; GMRAERR = YES (must be YES. Any other value will cause the EIE to fail.)
; GMRAERRBY = Pointer to the New Person file.
; GMRAERRDT = Fileman date.time (3150812.143206)
; GMRACMTS,0) = Total number of comments
; GMRACMTS,N) = Free text field for each comment
;
N HMPSTOP,HMPIEN,HMPDFN
S HMPIEN=$P(DATA,U,1)
D CHECKREQ
Q:HMPSTOP=1
D PARSE
I '$D(^GMR(120.8,HMPIEN)) D MSG^HMPTOOLS("Allergy "_HMPIEN_" does not exist",2) D ERROR Q
D EDITSAVE^ORWDAL32(.RSLT,HMPIEN,HMPDFN,.DATA)
S HMP=$NA(^TMP("HMP",$J)) K @HMP
S FILTER("id")=HMPIEN ;ien for the entry into the allergy file
S FILTER("patientId")=HMPDFN ;patient identifier
S FILTER("domain")="allergy" ;domain name for write back and freshness stream staging
S FILTER("noHead")=1 ;no header record required.
D GET^HMPDJ(.RSLT,.FILTER) ;build the JSON array in the ^TMP global
K ^TMP("ALLERGY",$J)
M ^TMP("ALLERGY",$J)=@RSLT
S RSLT=$NA(^TMP("ALLERGY",$J))
S HMPFCNT=0
S HMPUID=$$SETUID^HMPUTILS("allergy",HMPDFN,HMPIEN)
S HMPE=^TMP("ALLERGY",$J,1,1)
S STMPTM=$TR($P($P(HMPE,"lastUpdateTime",2),","),""":")
D ADHOC^HMPUTIL2("allergy",HMPFCNT,HMPDFN,HMPUID,STMPTM)
K RSLT
S RSLT=$$EXTRACT(HMP)
M ^TMP("HMPALL",$J)=RSLT
K RSLT
S RSLT=$NA(^TMP("HMPALL",$J))
;Clear work files
K @HMP
Q
;
CHECKREQ ; check for required fields
;Removed DFN from the input parameter DATA but for integrity purposes (and not to modify
;too much code), we need to keep the number of pieces in DATA the same.
I HMPIEN'=+HMPIEN D MSG^HMPTOOLS("Allergy identifier is invalid/null: "_HMPIEN) D ERROR Q
I '$D(^GMR(120.8,HMPIEN)) D MSG^HMPTOOLS("Allergy identifier "_HMPIEN_" does not exist.") D ERROR Q
S DATA=$P(DATA,U)_U_$P($G(^GMR(120.8,HMPIEN,0)),U)_U_$P(DATA,U,2,999)
S HMPSTOP=0
I $P(DATA,U,1)'?1N.N D MSG^HMPTOOLS("Allergy Identifier must be numeric",1) D ERROR Q
I $P(DATA,U,2)'?1N.N D MSG^HMPTOOLS("Patient Identifier ",2,"must be numeric") D ERROR Q
I $P(DATA,U,3)'="YES" D MSG^HMPTOOLS("EIE indicator",2,"must be set to YES") D ERROR Q
I $D(^GMR(120.8,HMPIEN,"ER"))>0 D MSG^HMPTOOLS("Allergy already entered in error: "_HMPIEN) D ERROR Q
Q
;
CHKDATE ;CHECK DATES FOR PROPER FORMAT OF DATE.
N HMPDT
S HMPSTOP=0
S HMPDT=$P($G(DATA("GMRACHT",1)),".",1)
I $L(HMPDT)'=7 D MSG^HMPTOOLS("Date "_HMPDT_" not formatted correctly",2) D ERROR Q
S HMPDT=$P($G(DATA("GMRAORDT")),".",1)
I $L(HMPDT)'=7 D MSG^HMPTOOLS("Date "_HMPDT_" not formatted correctly",2) D ERROR Q
S HMPDT=$P($G(GMRAERRDT),".",1)
I $L(HMPDT)'=7 D MSG^HMPTOOLS("Date "_HMPDT_" not formatted correctly",2) D ERROR Q
Q
;
PARSE ;Parse data string into data elements for EDITSAVE^ORWDAL32
S HMPDFN=$P(DATA,U,2)
S DATA("GMRAERR")=$P(DATA,U,3)
S DATA("GMRAERRBY")=$P(DATA,U,4)
S DATA("GMRAERRDT")=$P(DATA,U,5)
S DATA("GMRAERRCMTS",0)=$P(DATA,U,6)
S DATA("GMRAERRCMTS",1)=$P(DATA,U,7)
Q
;
ERROR ;handle errors generated by MSG^HMPTOOLS
S HMPSTOP=1
S ^TMP("HMP",$J,1,1)=RSLT(1)
S RSLT=$NA(^TMP("HMP",$J))
K RSLT(1)
Q
;
N HMPSTOP,HMPFND
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:$G(^TMP("HMPF",$J,I,J))=""
.. Q:$P(^TMP("HMPF",$J,I,J),",",1)'["allergy"
.. 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPWB1 7870 printed Sep 23, 2025@19:30:45 Page 2
HMPWB1 ; Agilex/EJK/JD - WRITE BACK ACTIVITY;Nov 5, 2015@16:15:08
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2,3**;Sep 01, 2011;Build 15
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; EDITSAVE^ORWDAL32 6427
+7 ;
+8 QUIT
+9 ; allergy write back from eHMP-UI to VistA
ALLERGY(RSLT,IEN,DFN,DATA) ;file allergy data
+1 ; RSLT - result, passed by reference
+2 ; IEN - zero for new allergy, or IEN for edit
+3 ; DFN - patient identifier
+4 ; DATA - array of allergy data. Subscript names are required.
+5 ; ("GMRACHT",0)=1 - Chart Marked indicator
+6 ; ("GMRACHT",1)=3150603.0905 - Date/Time Chart Marked
+7 ; ("GMRAGNT")="DIGITOXIN^9;PSNDF(50.6," - Allergy and Pointer to Allergen File
+8 ; ("GMRAOBHX")="o^OBSERVED" - (O)bserved or (H)istorical
+9 ; ("GMRAORIG")=10000000224 - Pointer to VA DRUG CLASS File (50.605)
+10 ; ("GMRAORDT")=3150603.0805 - Allergy assessmant date and time.
+11 ; ("GMRASEVR")=2 - Severity of Allergy. 1=Mild, 2=Moderate, 3=Severe
+12 ; ("GMRATYPE")="D^Drug" - Type of Allergen (F)ood or (D)rug
+13 ; ("GMRANATR")="A^Allergy" - Mechanism of Allergy (A)llergy, (P)harmacologic, (U)nknown.
+14 ; ("GMRASYMP",0)=2 - Number of Symptoms
+15 ; ("GMRASYMP",1)="2^ITCHING,WATERING EYES" - IEN and Description of Symptom 1
+16 ; ("GMRASYMP",2)="133^RASH" - IEN and Description of Symptom 2
+17 ;
+18 IF $GET(DFN)'>0
DO MSG^HMPTOOLS("DFN",1)
QUIT
+19 IF '$DATA(DATA)
DO MSG^HMPTOOLS("DATA Array",1)
QUIT
+20 NEW CMMT,FILTER,GMR0,GMRA,GMR0,GMRIEN,HMPALRGY,HMPDATA,HMPDFN,HMPSITE,I,ORY,REAC,STMPTM,USER,VPRI,X,XWBOS,Y
+21 NEW HMPIDX,HMPSTOP,HMPDFN
+22 SET HMPSTOP=0
+23 ;
+24 NEW $ESTACK,$ETRAP,ERRPAT,ERRMSG,D0
+25 SET HMPDFN=DFN
+26 SET $ETRAP="D ERRHDLR^HMPDERRH"
SET ERRPAT=DFN
+27 SET ERRMSG="A problem occurred in the allergy domain, routine: "_$TEXT(+0)
+28 ; indicate that we're in the RPC broker, prevent interactive calls
SET XWBOS=$$NOW^XLFDT
+29 ;DE6629 - PB - Sep 7, 2016 - check DATA("GMRAGNT" and strip out all but the file root.
+30 IF $PIECE(DATA("GMRAGNT"),",",2)'=""
NEW GMR1
SET GMR1=$PIECE(DATA("GMRAGNT"),",",1)
SET DATA("GMRAGNT")=$PIECE(GMR1,";",2)_","
+31 LOCK +^GMR(120.8,0):5
+32 ; update ADVERSE REACTION ASSESSMENT (#120.86)
DO EDITSAVE^ORWDAL32(.ORY,IEN,DFN,.DATA)
+33 ; ejk US3232 if failure to file, send error message as result.
+34 LOCK -^GMR(120.8,0)
+35 IF $PIECE(ORY,"^",1)=-1
DO MSG^HMPTOOLS($PIECE(ORY,"^",2))
DO ERROR
QUIT
+36 IF $PIECE(ORY,U,1)=0
IF '$DATA(D0)
Begin DoDot:1
+37 SET HMPSTOP=0
SET HMPIDX=""
+38 FOR
SET HMPIDX=$ORDER(^GMR(120.8,"B",DFN,HMPIDX),-1)
if HMPIDX=""!(HMPSTOP=1)
QUIT
Begin DoDot:2
+39 SET GMR0=$GET(^GMR(120.8,HMPIDX,0))
+40 IF $PIECE(GMR0,U,1)=HMPDFN
IF $PIECE(GMR0,U,2)=$PIECE(DATA("GMRAGNT"),U,1)
SET D0=HMPIDX
SET DFN=HMPDFN
SET HMPSTOP=1
+41 QUIT
End DoDot:2
+42 QUIT
End DoDot:1
+43 IF HMPSTOP
SET D0=HMPIDX
SET DFN=HMPDFN
+44 ; return value in RSLT
+45 SET HMP=$NAME(^TMP("HMP",$JOB))
KILL @HMP
+46 ;ien for the entry into the allergy file
SET FILTER("id")=D0
+47 ;patient identifier
SET FILTER("patientId")=DFN
+48 ;domain name for write back and freshness stream staging
SET FILTER("domain")="allergy"
+49 ;no header record required.
SET FILTER("noHead")=1
+50 ;build the JSON array in the ^TMP global
DO GET^HMPDJ(.RSLT,.FILTER)
+51 KILL ^TMP("ALLERGY",$JOB)
+52 MERGE ^TMP("ALLERGY",$JOB)=@RSLT
+53 SET RSLT=$NAME(^TMP("ALLERGY",$JOB))
+54 SET HMPFCNT=0
+55 SET HMPUID=$$SETUID^HMPUTILS("allergy",DFN,D0)
+56 SET HMPE=^TMP("ALLERGY",$JOB,1,1)
+57 SET STMPTM=$TRANSLATE($PIECE($PIECE(HMPE,"lastUpdateTime",2),","),""":")
+58 DO ADHOC^HMPUTIL2("allergy",HMPFCNT,DFN,HMPUID,STMPTM)
+59 KILL RSLT
+60 SET RSLT=$$EXTRACT(HMP)
+61 MERGE ^TMP("HMPALL",$JOB)=RSLT
+62 KILL RSLT
+63 SET RSLT=$NAME(^TMP("HMPALL",$JOB))
+64 ;Clear work files
+65 KILL @HMP
+66 QUIT
+67 ;
ALLEIE(RSLT,DATA) ;file allergy entered in error
+1 ;Since DFN is not relevant as an input parameter, we removed it from the DATA string
+2 ;Once we know the allergy IEN, DFN will also be known. JD - 11/5/15.
+3 ; RSLT - result, passed by reference
+4 ; DATA - contains all information needed to mark a Allergy as Entered in Error
+5 ; IEN^GMRAERR^GMRAERRBY^GMRAERRDT^GMRACMTS,0)^GMRACMTS,1)
+6 ; IEN = Pointer to the Allergy to be marked as Entered in Error
+7 ; GMRAERR = YES (must be YES. Any other value will cause the EIE to fail.)
+8 ; GMRAERRBY = Pointer to the New Person file.
+9 ; GMRAERRDT = Fileman date.time (3150812.143206)
+10 ; GMRACMTS,0) = Total number of comments
+11 ; GMRACMTS,N) = Free text field for each comment
+12 ;
+13 NEW HMPSTOP,HMPIEN,HMPDFN
+14 SET HMPIEN=$PIECE(DATA,U,1)
+15 DO CHECKREQ
+16 if HMPSTOP=1
QUIT
+17 DO PARSE
+18 IF '$DATA(^GMR(120.8,HMPIEN))
DO MSG^HMPTOOLS("Allergy "_HMPIEN_" does not exist",2)
DO ERROR
QUIT
+19 DO EDITSAVE^ORWDAL32(.RSLT,HMPIEN,HMPDFN,.DATA)
+20 SET HMP=$NAME(^TMP("HMP",$JOB))
KILL @HMP
+21 ;ien for the entry into the allergy file
SET FILTER("id")=HMPIEN
+22 ;patient identifier
SET FILTER("patientId")=HMPDFN
+23 ;domain name for write back and freshness stream staging
SET FILTER("domain")="allergy"
+24 ;no header record required.
SET FILTER("noHead")=1
+25 ;build the JSON array in the ^TMP global
DO GET^HMPDJ(.RSLT,.FILTER)
+26 KILL ^TMP("ALLERGY",$JOB)
+27 MERGE ^TMP("ALLERGY",$JOB)=@RSLT
+28 SET RSLT=$NAME(^TMP("ALLERGY",$JOB))
+29 SET HMPFCNT=0
+30 SET HMPUID=$$SETUID^HMPUTILS("allergy",HMPDFN,HMPIEN)
+31 SET HMPE=^TMP("ALLERGY",$JOB,1,1)
+32 SET STMPTM=$TRANSLATE($PIECE($PIECE(HMPE,"lastUpdateTime",2),","),""":")
+33 DO ADHOC^HMPUTIL2("allergy",HMPFCNT,HMPDFN,HMPUID,STMPTM)
+34 KILL RSLT
+35 SET RSLT=$$EXTRACT(HMP)
+36 MERGE ^TMP("HMPALL",$JOB)=RSLT
+37 KILL RSLT
+38 SET RSLT=$NAME(^TMP("HMPALL",$JOB))
+39 ;Clear work files
+40 KILL @HMP
+41 QUIT
+42 ;
CHECKREQ ; check for required fields
+1 ;Removed DFN from the input parameter DATA but for integrity purposes (and not to modify
+2 ;too much code), we need to keep the number of pieces in DATA the same.
+3 IF HMPIEN'=+HMPIEN
DO MSG^HMPTOOLS("Allergy identifier is invalid/null: "_HMPIEN)
DO ERROR
QUIT
+4 IF '$DATA(^GMR(120.8,HMPIEN))
DO MSG^HMPTOOLS("Allergy identifier "_HMPIEN_" does not exist.")
DO ERROR
QUIT
+5 SET DATA=$PIECE(DATA,U)_U_$PIECE($GET(^GMR(120.8,HMPIEN,0)),U)_U_$PIECE(DATA,U,2,999)
+6 SET HMPSTOP=0
+7 IF $PIECE(DATA,U,1)'?1N.N
DO MSG^HMPTOOLS("Allergy Identifier must be numeric",1)
DO ERROR
QUIT
+8 IF $PIECE(DATA,U,2)'?1N.N
DO MSG^HMPTOOLS("Patient Identifier ",2,"must be numeric")
DO ERROR
QUIT
+9 IF $PIECE(DATA,U,3)'="YES"
DO MSG^HMPTOOLS("EIE indicator",2,"must be set to YES")
DO ERROR
QUIT
+10 IF $DATA(^GMR(120.8,HMPIEN,"ER"))>0
DO MSG^HMPTOOLS("Allergy already entered in error: "_HMPIEN)
DO ERROR
QUIT
+11 QUIT
+12 ;
CHKDATE ;CHECK DATES FOR PROPER FORMAT OF DATE.
+1 NEW HMPDT
+2 SET HMPSTOP=0
+3 SET HMPDT=$PIECE($GET(DATA("GMRACHT",1)),".",1)
+4 IF $LENGTH(HMPDT)'=7
DO MSG^HMPTOOLS("Date "_HMPDT_" not formatted correctly",2)
DO ERROR
QUIT
+5 SET HMPDT=$PIECE($GET(DATA("GMRAORDT")),".",1)
+6 IF $LENGTH(HMPDT)'=7
DO MSG^HMPTOOLS("Date "_HMPDT_" not formatted correctly",2)
DO ERROR
QUIT
+7 SET HMPDT=$PIECE($GET(GMRAERRDT),".",1)
+8 IF $LENGTH(HMPDT)'=7
DO MSG^HMPTOOLS("Date "_HMPDT_" not formatted correctly",2)
DO ERROR
QUIT
+9 QUIT
+10 ;
PARSE ;Parse data string into data elements for EDITSAVE^ORWDAL32
+1 SET HMPDFN=$PIECE(DATA,U,2)
+2 SET DATA("GMRAERR")=$PIECE(DATA,U,3)
+3 SET DATA("GMRAERRBY")=$PIECE(DATA,U,4)
+4 SET DATA("GMRAERRDT")=$PIECE(DATA,U,5)
+5 SET DATA("GMRAERRCMTS",0)=$PIECE(DATA,U,6)
+6 SET DATA("GMRAERRCMTS",1)=$PIECE(DATA,U,7)
+7 QUIT
+8 ;
ERROR ;handle errors generated by MSG^HMPTOOLS
+1 SET HMPSTOP=1
+2 SET ^TMP("HMP",$JOB,1,1)=RSLT(1)
+3 SET RSLT=$NAME(^TMP("HMP",$JOB))
+4 KILL RSLT(1)
+5 QUIT
+6 ;
+1 NEW HMPSTOP,HMPFND
+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 $GET(^TMP("HMPF",$JOB,I,J))=""
QUIT
+12 if $PIECE(^TMP("HMPF",$JOB,I,J),",",1)'["allergy"
QUIT
+13 if $PIECE(^TMP("HMPF",$JOB,I,J),",",4)'["localId"
QUIT
+14 if $PIECE(^TMP("HMPF",$JOB,I,J),"
QUIT
+15 SET X=X+1
+16 SET RSLT(X)=$GET(^TMP("HMPF",$JOB,I,J))
+17 FOR
SET J=$ORDER(^TMP("HMPF",$JOB,I,J))
if J=""
QUIT
Begin DoDot:3
+18 if $PIECE(^TMP("HMPF",$JOB,I,J),"
QUIT
+19 SET X=X+1
+20 SET RSLT(X)=$GET(^TMP("HMPF",$JOB,I,J))
+21 SET HMPFND=1
+22 QUIT
End DoDot:3
+23 SET I=$ORDER(^TMP("HMPF",$JOB,I))
+24 QUIT
End DoDot:2
+25 QUIT
End DoDot:1
+26 QUIT RSLT
