HMPDJ09 ;SLC/MKB,ASMR/RRB,OB,MAT,CPC,HM - PCE;Apr 13, 2016 16:04:25
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,2**;May 15, 2016;Build 28
;Per VA Directive 6402, this routine should not be modified.
;
;DE4068 - reworked all PCRMINDX references to include ICD10
;
; External References DBIA#
; ------------------- -----
; ^AUPNVSIT 2028
; ^PXRMINDX 4290
; ^SC 10040
; ^VA(200 10060
; DIC 2051
; DILFD 2055
; DIQ 2056
; PXAPI,^TMP("PXKENC" 1894
; VALM1 10116
; XUAF4 2171
;
; All tags expect DFN, ID, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
Q
;
PX(FNUM) ; -- PCE item(s)
I $G(HMPID) D PXA(HMPID) Q
N HMPIDT,ID D SORT ;sort ^PXRMINDX into ^TMP("HMPPX",$J,IDT)
S HMPIDT=0 F S HMPIDT=$O(^TMP("HMPPX",$J,HMPIDT)) Q:HMPIDT<1 D Q:HMPI'<HMPMAX
. S ID=0 F S ID=$O(^TMP("HMPPX",$J,HMPIDT,ID)) Q:ID<1 D PX1 Q:HMPI'<HMPMAX
K ^TMP("HMPPX",$J)
Q
;
PXA(ID) ; -- find ID in ^PXRMINDX(FNUM), fall thru to PX1 if successful
N N,ROOT,IDX,P,ITEM,DATE,HMPIDT,ICDSYS
S N=+$P(FNUM,".",2) K ^TMP("HMPPX",$J)
I N=7!(N=18) S ROOT="^PXRMINDX("_FNUM_",""PPI"","_+$G(DFN)
E S ROOT="^PXRMINDX("_FNUM_",""PI"","_+$G(DFN)
S IDX=ROOT_")" F S IDX=$Q(@IDX) Q:$P(IDX,",",1,3)'=ROOT D
. S P=$L(IDX,",") Q:ID'=+$P(IDX,",",P) ;last subscript
. S DATE=+$P(IDX,",",P-1),ITEM=+$P(IDX,",",P-2)
. S HMPIDT=9999999-DATE,^TMP("HMPPX",$J,HMPIDT,ID)=ITEM_U_DATE
;DE4068 also check for ICD10
I N=7 S ROOT="^PXRMINDX("_FNUM_",""10D"",""PPI"","_+$G(DFN) D
. S IDX=ROOT_")" F S IDX=$Q(@IDX) Q:$P(IDX,",",1,4)'=ROOT D
.. S P=$L(IDX,",") Q:ID'=+$P(IDX,",",P) ;last subscript
.. S DATE=+$P(IDX,",",P-1),ITEM=+$P(IDX,",",P-2)
.. S HMPIDT=9999999-DATE,^TMP("HMPPX",$J,HMPIDT,ID)=ITEM_U_DATE
Q:'$D(^TMP("HMPPX",$J)) ;not found
PX1 ; -- PCE ^TMP("HMPPX",$J,HMPIDT,ID)=ITM^DATE for FNUM
N N,COLL,FAC,FLD,HMPF,I,LOC,LOTIEN,PCE,TAG,TMP,VISIT,X,X0,X12,Y
N $ES,$ET,ERRPAT,ERRMSG
N ERR,FLDS,FLG,VISITIEN
S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
S N=+$P(FNUM,".",2),TAG=$S(N=7:"VPOV",N=11:"VIMM",N=12:"VSKIN",N=13:"VXAM",N=16:"VPEDU",N=18:"VCPT",1:"VHF")
S ERRMSG="A problem occurred converting record "_ID_" for "_TAG
D @(TAG_"^PXPXRM(ID,.HMPF)")
;
S PCE("localId")=ID,TMP=$G(^TMP("HMPPX",$J,HMPIDT,ID))
S COLL=$S(N=7:"pov",N=11:"immunization",N=12:"skin",N=13:"exam",N=16:"education",N=18:"cpt",1:"factor")
S PCE("uid")=$$SETUID^HMPUTILS(COLL,DFN,ID)
; TAG=$S(N=23:"recorded",N=11:"administeredDateTime",1:"dateTimeEntered")
S TAG=$S(N=11:"administeredDateTime",1:"entered")
S PCE(TAG)=$$JSONDT^HMPUTILS($P(TMP,U,2)) I $L(PCE(TAG))<14 S PCE(TAG)=$E(PCE(TAG)_"000000",1,14)
I N=7!(N=18) I $G(FILTER("freshnessDateTime")) S PCE(TAG)=$$JSONDT^HMPUTILS(FILTER("freshnessDateTime")) ;DE4068
S PCE("name")=$$EXTERNAL^DILFD(FNUM,.01,,+TMP)
S VISIT=+$G(HMPF("VISIT")),PCE("encounterUid")=$$SETUID^HMPUTILS("visit",DFN,VISIT)
S PCE("encounterName")=$$NAME^HMPDJ04(VISIT)
;DE2818, ^AUPNVSIT - ICR 2028
; get VISIT information 0th node
; 9000010 - Visit
S VISITIEN=VISIT_",",FLG="I",FLDS=".06;.22;"
D GETS^DIQ(9000010,VISITIEN,FLDS,FLG,"X0","ERR")
S FAC=$G(X0(9000010,VISITIEN,.06,"I")),LOC=$G(X0(9000010,VISITIEN,.22,"I"))
;
S:FAC X=$$STA^XUAF4(FAC)_U_$P($$NS^XUAF4(FAC),U)
S:'FAC X=$$FAC^HMPD(LOC)
D FACILITY^HMPUTILS(X,"PCE")
;DE2818 ^SC global reference changed to FileMan
S:LOC PCE("locationUid")=$$SETUID^HMPUTILS("location",,LOC),PCE("locationName")=$$GET1^DIQ(44,LOC_",",.01)
S:$L($G(HMPF("COMMENTS"))) PCE("comment")=HMPF("COMMENTS")
POV I FNUM=9000010.07 D G PXQ
. S X=$G(HMPF("PRIMARY/SECONDARY")),PCE("type")=$S($L(X):X,1:"U")
. S X=PCE("name"),PCE("icdCode")=$$SETNCS^HMPUTILS("icd",X)
. S X=$G(HMPF("PROVIDER NARRATIVE")),PCE("name")=$$EXTERNAL^DILFD(9000010.07,.04,,X)
CPT I FNUM=9000010.18 D G PXQ
. S X=$G(HMPF("PRINCIPAL PROCEDURE")),PCE("type")=$S($L(X):X,1:"U")
. S X=PCE("name"),PCE("cptCode")=$$SETNCS^HMPUTILS("cpt",X)
. S X=$G(HMPF("PROVIDER NARRATIVE")),PCE("name")=$$EXTERNAL^DILFD(9000010.18,.04,,X)
. S PCE("quantity")=HMPF("QUANTITY")
S X=$G(HMPF("VALUE")),FLD=$S(FNUM=9000010.16:.06,1:.04)
S Y=$$EXTERNAL^DILFD(FNUM,FLD,,X)
IM I FNUM=9000010.11 D G PXQ ;immunization
. D VIMM(ID,.HMPF,VISIT)
. D:$L($G(HMPF("IMMCODE"))) VIMIMM(HMPF("IMMCODE"),.HMPF)
. I $L($G(HMPF("LOTNUMBER"))) D
.. S LOTIEN=$$FIND1^DIC(9999999.41,,"MX",HMPF("LOTNUMBER"),"B",,"ERR")
.. D VIML(LOTIEN,.HMPF)
.. S PCE("lotNumber")=HMPF("LOTNUMBER")
.. S PCE("manufacturer")=HMPF("MANUFACTURER")
.. S PCE("expirationDate")=$E($$JSONDT^HMPUTILS(HMPF("EXPDATE"))_"000000",1,14)
. S:$L($G(HMPF("INFOSRC"))) PCE("eventInformationSource")=HMPF("INFOSRC")
. S:$L($G(HMPF("ENCLOC"))) PCE("encounterLocation")=HMPF("ENCLOC")
. S:$L($G(HMPF("ORDPRV"))) PCE("orderingProvider")=HMPF("ORDPRV")
. S:$L($G(HMPF("CVXCODE"))) PCE("cvxCode")=HMPF("CVXCODE")
. S:$L($G(HMPF("ROUTE"))) PCE("routeOfAdministration")=HMPF("ROUTE")
. S:$L($G(HMPF("ADMNSITE"))) PCE("siteOfAdministration")=HMPF("ADMNSITE")
. I $L($G(HMPF("EVNTDAT"))) D
.. S PCE("eventDate")=$E($$JSONDT^HMPUTILS(HMPF("EVNTDAT"))_"000000",1,14)
. S:$L($G(HMPF("DOSE"))) PCE("dosage")=HMPF("DOSE")
. S:$L($G(HMPF("DOSEUNITS"))) PCE("dosageUnits")=HMPF("DOSEUNITS")
. S:$L($G(HMPF("VISDAT"))) PCE("visData")=HMPF("VISDAT")
. S:$L($G(HMPF("REMARKS"))) PCE("remarks")=HMPF("REMARKS")
. S:$L(Y) PCE("seriesName")=Y,PCE("seriesCode")=$$SETUID^HMPUTILS("series",DFN,Y)
. I $L($G(HMPF("REACTION"))) D
.. S PCE("reactionName")=$$EXTERNAL^DILFD(9000010.11,.06,,HMPF("REACTION"))
.. S PCE("reactionCode")=$$SETUID^HMPUTILS("reaction",DFN,HMPF("REACTION"))
. S PCE("contraindicated")=$S(+$G(HMPF("CONTRAINDICATED")):"true",1:"false")
. I '$D(^TMP("PXKENC",$J,VISIT)) D ENCEVENT^PXAPI(VISIT,1)
. S X12=$G(^TMP("PXKENC",$J,VISIT,"IMM",ID,12))
. S X=$P(X12,U,4) S:'X X=$P(X12,U,2)
. I 'X S I=0 F S I=$O(^TMP("PXKENC",$J,VISIT,"PRV",I)) Q:I<1 I $P($G(^TMP("PXKENC",$J,VISIT,"PRV",I,0)),U,4)="P" S X=+^TMP("PXKENC",$J,VISIT,"PRV",I,0) Q
. ;DE2818, ^VA(200 reference changed to FileMan
. S:X PCE("performerUid")=$$SETUID^HMPUTILS("user",,+X),PCE("performerName")=$$GET1^DIQ(200,X_",",.01)
. ; CPT mapping
. S X=+$$FIND1^DIC(811.1,,"QX",+TMP_";AUTTIMM(","B") I X>0 D
.. S Y=$$GET1^DIQ(811.1,X_",",.02,"I") Q:Y<1
.. N CPT S CPT=$G(@(U_$P(Y,";",2)_+Y_",0)"))
.. S PCE("cptCode")=$$SETNCS^HMPUTILS("cpt",+CPT)
.. S (PCE("summary"),PCE("cptName"))=$P(CPT,U,2)
. ; US14129 - Add cdc full vaccine name to return
. M:$D(HMPF("CDCNAME")) PCE("cdcFullVaccineName","\")=HMPF("CDCNAME")
. N I S I="" F S I=$O(HMPF("VIS",I)) Q:'I D
. . S PCE("vis",I,"visName")=$G(HMPF("VIS",I,"VISNAME"))
. . S PCE("vis",I,"editionDate")=$G(HMPF("VIS",I,"EDITIONDATE"))
. . S PCE("vis",I,"language")=$G(HMPF("VIS",I,"LANGUAGE"))
. . S PCE("vis",I,"offeredDate")=$G(HMPF("VIS",I,"OFFEREDDATE"))
HF I FNUM=9000010.23 D G PXQ ;health factor
. S:$L(X) PCE("severityUid")=$$SETVURN^HMPUTILS("factor-severity",X),PCE("severityName")=$$LOWER^VALM1(Y)
. S X=$$GET1^DIQ(9999999.64,+TMP_",",.03,"I") I X D
.. S PCE("categoryUid")=$$SETVURN^HMPUTILS("factor-category",X)
.. S PCE("categoryName")=$$EXTERNAL^DILFD(9999999.64,.03,"",X)
. S X=$$GET1^DIQ(9999999.64,+TMP_",",.08)
. I $E(X)="Y" S PCE("display")="true"
. S PCE("kind")="Health Factor",PCE("summary")=PCE("name")
SK I FNUM=9000010.12 D ;skin test [fall thru to set result]
. S:$L($G(HMPF("READING"))) PCE("reading")=HMPF("READING")
. S:$G(HMPF("DATE READ")) PCE("dateRead")=$$JSONDT^HMPUTILS(HMPF("DATE READ"))
S:$L(Y) PCE("result")=Y
PXQ ;finish
S PCE("lastUpdateTime")=$$EN^HMPSTMP(COLL) ; RHL 20150115
S PCE("stampTime")=PCE("lastUpdateTime") ; RHL 20150115
;US6734 - pre-compile metastamp
I $G(HMPMETA) D ADD^HMPMETA(COLL,PCE("uid"),PCE("stampTime")) Q:HMPMETA=1 ;US11019/US6734
D ADD^HMPDJ("PCE",COLL)
Q
;
SORT ; -- build ^TMP("HMPPX",$J,9999999-DATE,DA)=ITEM^DATE in range
N TYPE,ITEM,DATE,DA,IDT K ^TMP("HMPPX",$J)
I FNUM=9000010.07!(FNUM=9000010.18) G PPI
PI ; from ^PXRMINDX(FNUM,"PI",DFN,ITEM,DATE,DA)
;DE2818, ^PXRMINDX - ICR 4290
S ITEM=0 F S ITEM=$O(^PXRMINDX(FNUM,"PI",+$G(DFN),ITEM)) Q:ITEM<1 D
. S DATE=0 F S DATE=$O(^PXRMINDX(FNUM,"PI",+$G(DFN),ITEM,DATE)) Q:DATE<1 D
.. Q:DATE<HMPSTART Q:DATE>HMPSTOP S IDT=9999999-DATE
.. S DA=0 F S DA=$O(^PXRMINDX(FNUM,"PI",+$G(DFN),ITEM,DATE,DA)) Q:DA<1 S ^TMP("HMPPX",$J,IDT,DA)=ITEM_U_DATE
Q
PPI ; from ^PXRMINDX(FNUM,"PPI",DFN,TYPE,ITEM,DATE,DA)
S TYPE="" F S TYPE=$O(^PXRMINDX(FNUM,"PPI",+$G(DFN),TYPE)) Q:TYPE="" D
. S ITEM=0 F S ITEM=$O(^PXRMINDX(FNUM,"PPI",+$G(DFN),TYPE,ITEM)) Q:ITEM<1 D
.. S DATE=0 F S DATE=$O(^PXRMINDX(FNUM,"PPI",+$G(DFN),TYPE,ITEM,DATE)) Q:DATE<1 D
... Q:DATE<HMPSTART Q:DATE>HMPSTOP S IDT=9999999-DATE
... S DA=0 F S DA=$O(^PXRMINDX(FNUM,"PPI",+$G(DFN),TYPE,ITEM,DATE,DA)) Q:DA<1 S ^TMP("HMPPX",$J,IDT,DA)=ITEM_U_DATE
Q:FNUM=9000010.18 ;
;for POV also check ICD10 CODES
S TYPE="" F S TYPE=$O(^PXRMINDX(FNUM,"10D","PPI",+$G(DFN),TYPE)) Q:TYPE="" D
. S ITEM="" F S ITEM=$O(^PXRMINDX(FNUM,"10D","PPI",+$G(DFN),TYPE,ITEM)) Q:ITEM="" D
.. S DATE=0 F S DATE=$O(^PXRMINDX(FNUM,"10D","PPI",+$G(DFN),TYPE,ITEM,DATE)) Q:DATE<1 D
... Q:DATE<HMPSTART Q:DATE>HMPSTOP S IDT=9999999-DATE
... S DA=0 F S DA=$O(^PXRMINDX(FNUM,"10D","PPI",+$G(DFN),TYPE,ITEM,DATE,DA)) Q:DA<1 S ^TMP("HMPPX",$J,IDT,DA)=ITEM_U_DATE
Q
PTF ; from ^PXRMINDX(45,"ICD9","PNI",DFN,TYPE,ITEM,DATE,DA)
;Purpose - Build ^TMP("HMPPX") from ^PXRMINDX(45,HMPISYS,"PNI",DFN)
;
;Called by - PTF^HMPDJ0 (if HMPID is not set)
;
;Assumptions -
;1. DFN, HMPSTART and HMPSTOP variables have been set in prior code
;2. ^TMP("HMPPX") does not exist and needs to be built
;3. '$G(HMPID)
;
;Modification History -
;US5630 (TW) - HMPISYS can be either "ICD" or "10D" (ICD-10)
;
N HMPISYS,HMPTYP,HMPDX,HMPDT,HMPITEM,HMPRDT
S HMPISYS="" F S HMPISYS=$O(^PXRMINDX(45,HMPISYS)) Q:HMPISYS="" D
. Q:'$D(^PXRMINDX(45,HMPISYS,"PNI",+$G(DFN)))
. S HMPTYP="" F S HMPTYP=$O(^PXRMINDX(45,HMPISYS,"PNI",+$G(DFN),HMPTYP)) Q:HMPTYP="" D
.. S HMPDX=0 F S HMPDX=$O(^PXRMINDX(45,HMPISYS,"PNI",+$G(DFN),HMPTYP,HMPDX)) Q:HMPDX="" D
... S HMPDT=0 F S HMPDT=$O(^PXRMINDX(45,HMPISYS,"PNI",+$G(DFN),HMPTYP,HMPDX,HMPDT)) Q:HMPDT<1 D
.... Q:HMPDT<HMPSTART Q:HMPDT>HMPSTOP S HMPRDT=9999999-HMPDT
.... S HMPITEM="" F S HMPITEM=$O(^PXRMINDX(45,HMPISYS,"PNI",+$G(DFN),HMPTYP,HMPDX,HMPDT,HMPITEM)) Q:HMPITEM="" S ^TMP("HMPPX",$J,HMPRDT,HMPITEM_";"_HMPTYP)=HMPDX_U_HMPDT_U_HMPISYS
Q
VIML(LOT,IMDATA) ;VIMM2.0 Return IMMUNIZATION LOT data (Lot #, Expiration Date, and Mfr. can also be in COMMENTS)
N ARR,DATA,ERR,FILE,FLDS,FLGS,IEN
S FILE=9999999.41 ;IMMUNIZATION LOT
S IEN=LOT_",",FLDS=".02;.09",FLGS="IE",ARR="DATA",ERR="ERR"
D GETS^DIQ(FILE,IEN,FLDS,FLGS,ARR,ERR)
;
; --- Expiration Date & Manufacturer
S IMDATA("EXPDATE")=$G(DATA(FILE,IEN,.09,"I"))
S IMDATA("MANUFACTURER")=$G(DATA(FILE,IEN,.02,"E"))
Q
VIMM(DA,IMDATA,VISIT) ;VIMM2.0 Return data for a specified V IMMUNIZATION entry.
N ADMIN1,ARR,DATA,ERR,FLDS,FLGS,IEN,INFO1,ROUTE1,TEMP,TMPGBL,VIS,VISIEN
; 9000010.11 - V IMMUNIZATION
S IEN=DA_",",FLDS=".01;.02;.03;.04;.05;.06;.07;.08;.09;.12;1101;1201;1202;1203;1204;1205;1206;1207;1301;1302;1303;1312;1313;80101;80102;81101;81201;81202;81203;2*"
S FLGS="IE",ARR="DATA",ERR="ERR"
D GETS^DIQ(9000010.11,IEN,FLDS,FLGS,ARR,ERR)
;
; Immunization Code
;US14129 - This line was causing VIMIMM to be sent the vaccine *name* not IEN. Had to fix it for the story.
S IMDATA("IMMCODE")=$G(DATA(9000010.11,IEN,.01,"I"))
;
; Dosage & Units
S IMDATA("DOSE")=$G(DATA(9000010.11,IEN,1312,"E"))
S IMDATA("DOSEUNITS")=$G(DATA(9000010.11,IEN,1313,"E"))
;
; Lot Number
S IMDATA("LOTNUMBER")=$G(DATA(9000010.11,IEN,1207,"E"))
;
; Ordering Provider
S IMDATA("ORDPRV")=$G(DATA(9000010.11,IEN,1202,"E"))
;
; Admin / Encounter Provuder
S IMDATA("ADMNPRV")=$G(DATA(9000010.11,IEN,1204,"E"))
;
; Event Date and Time
S IMDATA("EVNTDAT")=$G(DATA(9000010.11,IEN,1201,"I"))
;
; Remarks
; DE3454 - added logic for word processing field data - HM
N CT,X,WP,COUNT
S X=$$GET1^DIQ(9000010.11,IEN,1101,"","WP"),COUNT=0
I $D(WP(1)) S CT="" D
. F S CT=$O(WP(CT)) Q:CT="" S COUNT=COUNT+1
I COUNT>0 S IMDATA("REMARKS")="",CT="" D
. F S CT=$O(WP(CT)) Q:CT="" D
. . S IMDATA("REMARKS")=$S(CT'=COUNT:IMDATA("REMARKS")_WP(CT)_" "_$C(13)_$C(10),CT=COUNT:IMDATA("REMARKS")_WP(CT),1:0)
;
; Comments
S IMDATA("COMMENTS")=$G(DATA(9000010.11,IEN,81101,"E"))
;
; Information Source
S IMDATA("INFOSRC")=$G(DATA(9000010.11,IEN,1301,"E"))
;
; Route
S IMDATA("ROUTE")=$G(DATA(9000010.11,IEN,1302,"E"))
;
; Administration Site
S IMDATA("ADMNSITE")=$G(DATA(9000010.11,IEN,1303,"E"))
;
; Vaccine Information Statement (VIS)
S IMDATA("VISDAT")=$$VIMVIS(.DATA)
;US14129 - Add More VIS data to extract
D VIMVISNW(.DATA,.IMDATA)
Q
VIMIMM(IMMCODE,IMDATA) ;VIMM2.0 Return data for an IMMUNIZATION entry.
N ARR,DATA,ERR,FLDS,FLGS,IEN
; 9999999.14 - Immunization
S IEN=IMMCODE_",",FLDS=".03;2",FLGS="IE",ARR="DATA",ERR="ERR"
D GETS^DIQ(9999999.14,IEN,FLDS,FLGS,ARR,ERR)
;
; CVX code
S IMDATA("CVXCODE")=$G(DATA(9999999.14,IEN,.03,"E"))
; US14129 - Add cdc full vaccine name to return
; Use our existing API to format the Word Processing data for JSON
D SETTEXT^HMPUTILS($NA(DATA(9999999.14,IEN,2)),$NA(IMDATA("CDCNAME")))
Q
VIMVIS(DATA) ;VIMM2.0 Return an IMMUNIZATION's VACCINE INFORMATION STATEMENT(s).
N DT,SC,SL,VDX,VIS,VISALL,VISIEN
S (DT,VIS,VISALL,VDX)="",SL="/",SC=";"
S VISIEN="" F S VISIEN=$O(DATA(9000010.112,VISIEN)) Q:VISIEN="" D
. S VIS=$G(DATA(9000010.112,VISIEN,".01","E"))
. I $D(DATA(9000010.112,VISIEN,".02","I")) D
. . S DT=$G(DATA(9000010.112,VISIEN,".02","I")),DT=$E($$JSONDT^HMPUTILS(DT)_"000000",1,14)
. I $G(DT),$G(VIS)'="" S VISALL(VIS_SL_DT_SC)=""
S (VDX,VIS)="" F S VDX=$O(VISALL(VDX)) Q:VDX="" S VIS=VIS_" "_$C(13)_$C(10)_VDX ; DE3454 - added logic for word processing field data - HM
Q VIS
;
VIMVISNW(DATA,IMDATA) ;US14129 - Add VIS data to extract
N PTVISIEN,VISIEN,IEN,LANGIEN
S PTVISIEN="" F I=1:1 S PTVISIEN=$O(DATA(9000010.112,PTVISIEN)) Q:PTVISIEN="" D
. S VISIEN=$G(DATA(9000010.112,PTVISIEN,".01","I"))_"," Q:'VISIEN
. I $D(DATA(9000010.112,PTVISIEN,".01","E")) S IMDATA("VIS",I,"VISNAME")=$G(DATA(9000010.112,PTVISIEN,".01","E"))
. S:$G(DATA(9000010.112,PTVISIEN,".02","I")) IMDATA("VIS",I,"OFFEREDDATE")=$$JSONDT^HMPUTILS(DATA(9000010.112,PTVISIEN,".02","I"))
. D GETS^DIQ(920,VISIEN,".01;.02;.04","IE","DATA","ERR")
. S:$G(DATA(920,VISIEN,".02","I")) IMDATA("VIS",I,"EDITIONDATE")=$$JSONDT^HMPUTILS(DATA(920,VISIEN,".02","I"))
. ;Need to pull NAME (#1), not CODE (#.01), field from language file.
. S LANGIEN=$G(DATA(920,VISIEN,".04","I")) S:LANGIEN IMDATA("VIS",I,"LANGUAGE")=$$GET1^DIQ(.85,LANGIEN_",",1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPDJ09 15242 printed Apr 09, 2024@20:59:49 Page 2
HMPDJ09 ;SLC/MKB,ASMR/RRB,OB,MAT,CPC,HM - PCE;Apr 13, 2016 16:04:25
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,2**;May 15, 2016;Build 28
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;DE4068 - reworked all PCRMINDX references to include ICD10
+5 ;
+6 ; External References DBIA#
+7 ; ------------------- -----
+8 ; ^AUPNVSIT 2028
+9 ; ^PXRMINDX 4290
+10 ; ^SC 10040
+11 ; ^VA(200 10060
+12 ; DIC 2051
+13 ; DILFD 2055
+14 ; DIQ 2056
+15 ; PXAPI,^TMP("PXKENC" 1894
+16 ; VALM1 10116
+17 ; XUAF4 2171
+18 ;
+19 ; All tags expect DFN, ID, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
+20 QUIT
+21 ;
PX(FNUM) ; -- PCE item(s)
+1 IF $GET(HMPID)
DO PXA(HMPID)
QUIT
+2 ;sort ^PXRMINDX into ^TMP("HMPPX",$J,IDT)
NEW HMPIDT,ID
DO SORT
+3 SET HMPIDT=0
FOR
SET HMPIDT=$ORDER(^TMP("HMPPX",$JOB,HMPIDT))
if HMPIDT<1
QUIT
Begin DoDot:1
+4 SET ID=0
FOR
SET ID=$ORDER(^TMP("HMPPX",$JOB,HMPIDT,ID))
if ID<1
QUIT
DO PX1
if HMPI'<HMPMAX
QUIT
End DoDot:1
if HMPI'<HMPMAX
QUIT
+5 KILL ^TMP("HMPPX",$JOB)
+6 QUIT
+7 ;
PXA(ID) ; -- find ID in ^PXRMINDX(FNUM), fall thru to PX1 if successful
+1 NEW N,ROOT,IDX,P,ITEM,DATE,HMPIDT,ICDSYS
+2 SET N=+$PIECE(FNUM,".",2)
KILL ^TMP("HMPPX",$JOB)
+3 IF N=7!(N=18)
SET ROOT="^PXRMINDX("_FNUM_",""PPI"","_+$GET(DFN)
+4 IF '$TEST
SET ROOT="^PXRMINDX("_FNUM_",""PI"","_+$GET(DFN)
+5 SET IDX=ROOT_")"
FOR
SET IDX=$QUERY(@IDX)
if $PIECE(IDX,",",1,3)'=ROOT
QUIT
Begin DoDot:1
+6 ;last subscript
SET P=$LENGTH(IDX,",")
if ID'=+$PIECE(IDX,",",P)
QUIT
+7 SET DATE=+$PIECE(IDX,",",P-1)
SET ITEM=+$PIECE(IDX,",",P-2)
+8 SET HMPIDT=9999999-DATE
SET ^TMP("HMPPX",$JOB,HMPIDT,ID)=ITEM_U_DATE
End DoDot:1
+9 ;DE4068 also check for ICD10
+10 IF N=7
SET ROOT="^PXRMINDX("_FNUM_",""10D"",""PPI"","_+$GET(DFN)
Begin DoDot:1
+11 SET IDX=ROOT_")"
FOR
SET IDX=$QUERY(@IDX)
if $PIECE(IDX,",",1,4)'=ROOT
QUIT
Begin DoDot:2
+12 ;last subscript
SET P=$LENGTH(IDX,",")
if ID'=+$PIECE(IDX,",",P)
QUIT
+13 SET DATE=+$PIECE(IDX,",",P-1)
SET ITEM=+$PIECE(IDX,",",P-2)
+14 SET HMPIDT=9999999-DATE
SET ^TMP("HMPPX",$JOB,HMPIDT,ID)=ITEM_U_DATE
End DoDot:2
End DoDot:1
+15 ;not found
if '$DATA(^TMP("HMPPX",$JOB))
QUIT
PX1 ; -- PCE ^TMP("HMPPX",$J,HMPIDT,ID)=ITM^DATE for FNUM
+1 NEW N,COLL,FAC,FLD,HMPF,I,LOC,LOTIEN,PCE,TAG,TMP,VISIT,X,X0,X12,Y
+2 NEW $ESTACK,$ETRAP,ERRPAT,ERRMSG
+3 NEW ERR,FLDS,FLG,VISITIEN
+4 SET $ETRAP="D ERRHDLR^HMPDERRH"
SET ERRPAT=DFN
+5 SET N=+$PIECE(FNUM,".",2)
SET TAG=$SELECT(N=7:"VPOV",N=11:"VIMM",N=12:"VSKIN",N=13:"VXAM",N=16:"VPEDU",N=18:"VCPT",1:"VHF")
+6 SET ERRMSG="A problem occurred converting record "_ID_" for "_TAG
+7 DO @(TAG_"^PXPXRM(ID,.HMPF)")
+8 ;
+9 SET PCE("localId")=ID
SET TMP=$GET(^TMP("HMPPX",$JOB,HMPIDT,ID))
+10 SET COLL=$SELECT(N=7:"pov",N=11:"immunization",N=12:"skin",N=13:"exam",N=16:"education",N=18:"cpt",1:"factor")
+11 SET PCE("uid")=$$SETUID^HMPUTILS(COLL,DFN,ID)
+12 ; TAG=$S(N=23:"recorded",N=11:"administeredDateTime",1:"dateTimeEntered")
+13 SET TAG=$SELECT(N=11:"administeredDateTime",1:"entered")
+14 SET PCE(TAG)=$$JSONDT^HMPUTILS($PIECE(TMP,U,2))
IF $LENGTH(PCE(TAG))<14
SET PCE(TAG)=$EXTRACT(PCE(TAG)_"000000",1,14)
+15 ;DE4068
IF N=7!(N=18)
IF $GET(FILTER("freshnessDateTime"))
SET PCE(TAG)=$$JSONDT^HMPUTILS(FILTER("freshnessDateTime"))
+16 SET PCE("name")=$$EXTERNAL^DILFD(FNUM,.01,,+TMP)
+17 SET VISIT=+$GET(HMPF("VISIT"))
SET PCE("encounterUid")=$$SETUID^HMPUTILS("visit",DFN,VISIT)
+18 SET PCE("encounterName")=$$NAME^HMPDJ04(VISIT)
+19 ;DE2818, ^AUPNVSIT - ICR 2028
+20 ; get VISIT information 0th node
+21 ; 9000010 - Visit
+22 SET VISITIEN=VISIT_","
SET FLG="I"
SET FLDS=".06;.22;"
+23 DO GETS^DIQ(9000010,VISITIEN,FLDS,FLG,"X0","ERR")
+24 SET FAC=$GET(X0(9000010,VISITIEN,.06,"I"))
SET LOC=$GET(X0(9000010,VISITIEN,.22,"I"))
+25 ;
+26 if FAC
SET X=$$STA^XUAF4(FAC)_U_$PIECE($$NS^XUAF4(FAC),U)
+27 if 'FAC
SET X=$$FAC^HMPD(LOC)
+28 DO FACILITY^HMPUTILS(X,"PCE")
+29 ;DE2818 ^SC global reference changed to FileMan
+30 if LOC
SET PCE("locationUid")=$$SETUID^HMPUTILS("location",,LOC)
SET PCE("locationName")=$$GET1^DIQ(44,LOC_",",.01)
+31 if $LENGTH($GET(HMPF("COMMENTS")))
SET PCE("comment")=HMPF("COMMENTS")
POV IF FNUM=9000010.07
Begin DoDot:1
+1 SET X=$GET(HMPF("PRIMARY/SECONDARY"))
SET PCE("type")=$SELECT($LENGTH(X):X,1:"U")
+2 SET X=PCE("name")
SET PCE("icdCode")=$$SETNCS^HMPUTILS("icd",X)
+3 SET X=$GET(HMPF("PROVIDER NARRATIVE"))
SET PCE("name")=$$EXTERNAL^DILFD(9000010.07,.04,,X)
End DoDot:1
GOTO PXQ
CPT IF FNUM=9000010.18
Begin DoDot:1
+1 SET X=$GET(HMPF("PRINCIPAL PROCEDURE"))
SET PCE("type")=$SELECT($LENGTH(X):X,1:"U")
+2 SET X=PCE("name")
SET PCE("cptCode")=$$SETNCS^HMPUTILS("cpt",X)
+3 SET X=$GET(HMPF("PROVIDER NARRATIVE"))
SET PCE("name")=$$EXTERNAL^DILFD(9000010.18,.04,,X)
+4 SET PCE("quantity")=HMPF("QUANTITY")
End DoDot:1
GOTO PXQ
+5 SET X=$GET(HMPF("VALUE"))
SET FLD=$SELECT(FNUM=9000010.16:.06,1:.04)
+6 SET Y=$$EXTERNAL^DILFD(FNUM,FLD,,X)
IM ;immunization
IF FNUM=9000010.11
Begin DoDot:1
+1 DO VIMM(ID,.HMPF,VISIT)
+2 if $LENGTH($GET(HMPF("IMMCODE")))
DO VIMIMM(HMPF("IMMCODE"),.HMPF)
+3 IF $LENGTH($GET(HMPF("LOTNUMBER")))
Begin DoDot:2
+4 SET LOTIEN=$$FIND1^DIC(9999999.41,,"MX",HMPF("LOTNUMBER"),"B",,"ERR")
+5 DO VIML(LOTIEN,.HMPF)
+6 SET PCE("lotNumber")=HMPF("LOTNUMBER")
+7 SET PCE("manufacturer")=HMPF("MANUFACTURER")
+8 SET PCE("expirationDate")=$EXTRACT($$JSONDT^HMPUTILS(HMPF("EXPDATE"))_"000000",1,14)
End DoDot:2
+9 if $LENGTH($GET(HMPF("INFOSRC")))
SET PCE("eventInformationSource")=HMPF("INFOSRC")
+10 if $LENGTH($GET(HMPF("ENCLOC")))
SET PCE("encounterLocation")=HMPF("ENCLOC")
+11 if $LENGTH($GET(HMPF("ORDPRV")))
SET PCE("orderingProvider")=HMPF("ORDPRV")
+12 if $LENGTH($GET(HMPF("CVXCODE")))
SET PCE("cvxCode")=HMPF("CVXCODE")
+13 if $LENGTH($GET(HMPF("ROUTE")))
SET PCE("routeOfAdministration")=HMPF("ROUTE")
+14 if $LENGTH($GET(HMPF("ADMNSITE")))
SET PCE("siteOfAdministration")=HMPF("ADMNSITE")
+15 IF $LENGTH($GET(HMPF("EVNTDAT")))
Begin DoDot:2
+16 SET PCE("eventDate")=$EXTRACT($$JSONDT^HMPUTILS(HMPF("EVNTDAT"))_"000000",1,14)
End DoDot:2
+17 if $LENGTH($GET(HMPF("DOSE")))
SET PCE("dosage")=HMPF("DOSE")
+18 if $LENGTH($GET(HMPF("DOSEUNITS")))
SET PCE("dosageUnits")=HMPF("DOSEUNITS")
+19 if $LENGTH($GET(HMPF("VISDAT")))
SET PCE("visData")=HMPF("VISDAT")
+20 if $LENGTH($GET(HMPF("REMARKS")))
SET PCE("remarks")=HMPF("REMARKS")
+21 if $LENGTH(Y)
SET PCE("seriesName")=Y
SET PCE("seriesCode")=$$SETUID^HMPUTILS("series",DFN,Y)
+22 IF $LENGTH($GET(HMPF("REACTION")))
Begin DoDot:2
+23 SET PCE("reactionName")=$$EXTERNAL^DILFD(9000010.11,.06,,HMPF("REACTION"))
+24 SET PCE("reactionCode")=$$SETUID^HMPUTILS("reaction",DFN,HMPF("REACTION"))
End DoDot:2
+25 SET PCE("contraindicated")=$SELECT(+$GET(HMPF("CONTRAINDICATED")):"true",1:"false")
+26 IF '$DATA(^TMP("PXKENC",$JOB,VISIT))
DO ENCEVENT^PXAPI(VISIT,1)
+27 SET X12=$GET(^TMP("PXKENC",$JOB,VISIT,"IMM",ID,12))
+28 SET X=$PIECE(X12,U,4)
if 'X
SET X=$PIECE(X12,U,2)
+29 IF 'X
SET I=0
FOR
SET I=$ORDER(^TMP("PXKENC",$JOB,VISIT,"PRV",I))
if I<1
QUIT
IF $PIECE($GET(^TMP("PXKENC",$JOB,VISIT,"PRV",I,0)),U,4)="P"
SET X=+^TMP("PXKENC",$JOB,VISIT,"PRV",I,0)
QUIT
+30 ;DE2818, ^VA(200 reference changed to FileMan
+31 if X
SET PCE("performerUid")=$$SETUID^HMPUTILS("user",,+X)
SET PCE("performerName")=$$GET1^DIQ(200,X_",",.01)
+32 ; CPT mapping
+33 SET X=+$$FIND1^DIC(811.1,,"QX",+TMP_";AUTTIMM(","B")
IF X>0
Begin DoDot:2
+34 SET Y=$$GET1^DIQ(811.1,X_",",.02,"I")
if Y<1
QUIT
+35 NEW CPT
SET CPT=$GET(@(U_$PIECE(Y,";",2)_+Y_",0)"))
+36 SET PCE("cptCode")=$$SETNCS^HMPUTILS("cpt",+CPT)
+37 SET (PCE("summary"),PCE("cptName"))=$PIECE(CPT,U,2)
End DoDot:2
+38 ; US14129 - Add cdc full vaccine name to return
+39 if $DATA(HMPF("CDCNAME"))
MERGE PCE("cdcFullVaccineName","\")=HMPF("CDCNAME")
+40 NEW I
SET I=""
FOR
SET I=$ORDER(HMPF("VIS",I))
if 'I
QUIT
Begin DoDot:2
+41 SET PCE("vis",I,"visName")=$GET(HMPF("VIS",I,"VISNAME"))
+42 SET PCE("vis",I,"editionDate")=$GET(HMPF("VIS",I,"EDITIONDATE"))
+43 SET PCE("vis",I,"language")=$GET(HMPF("VIS",I,"LANGUAGE"))
+44 SET PCE("vis",I,"offeredDate")=$GET(HMPF("VIS",I,"OFFEREDDATE"))
End DoDot:2
End DoDot:1
GOTO PXQ
HF ;health factor
IF FNUM=9000010.23
Begin DoDot:1
+1 if $LENGTH(X)
SET PCE("severityUid")=$$SETVURN^HMPUTILS("factor-severity",X)
SET PCE("severityName")=$$LOWER^VALM1(Y)
+2 SET X=$$GET1^DIQ(9999999.64,+TMP_",",.03,"I")
IF X
Begin DoDot:2
+3 SET PCE("categoryUid")=$$SETVURN^HMPUTILS("factor-category",X)
+4 SET PCE("categoryName")=$$EXTERNAL^DILFD(9999999.64,.03,"",X)
End DoDot:2
+5 SET X=$$GET1^DIQ(9999999.64,+TMP_",",.08)
+6 IF $EXTRACT(X)="Y"
SET PCE("display")="true"
+7 SET PCE("kind")="Health Factor"
SET PCE("summary")=PCE("name")
End DoDot:1
GOTO PXQ
SK ;skin test [fall thru to set result]
IF FNUM=9000010.12
Begin DoDot:1
+1 if $LENGTH($GET(HMPF("READING")))
SET PCE("reading")=HMPF("READING")
+2 if $GET(HMPF("DATE READ"))
SET PCE("dateRead")=$$JSONDT^HMPUTILS(HMPF("DATE READ"))
End DoDot:1
+3 if $LENGTH(Y)
SET PCE("result")=Y
PXQ ;finish
+1 ; RHL 20150115
SET PCE("lastUpdateTime")=$$EN^HMPSTMP(COLL)
+2 ; RHL 20150115
SET PCE("stampTime")=PCE("lastUpdateTime")
+3 ;US6734 - pre-compile metastamp
+4 ;US11019/US6734
IF $GET(HMPMETA)
DO ADD^HMPMETA(COLL,PCE("uid"),PCE("stampTime"))
if HMPMETA=1
QUIT
+5 DO ADD^HMPDJ("PCE",COLL)
+6 QUIT
+7 ;
SORT ; -- build ^TMP("HMPPX",$J,9999999-DATE,DA)=ITEM^DATE in range
+1 NEW TYPE,ITEM,DATE,DA,IDT
KILL ^TMP("HMPPX",$JOB)
+2 IF FNUM=9000010.07!(FNUM=9000010.18)
GOTO PPI
PI ; from ^PXRMINDX(FNUM,"PI",DFN,ITEM,DATE,DA)
+1 ;DE2818, ^PXRMINDX - ICR 4290
+2 SET ITEM=0
FOR
SET ITEM=$ORDER(^PXRMINDX(FNUM,"PI",+$GET(DFN),ITEM))
if ITEM<1
QUIT
Begin DoDot:1
+3 SET DATE=0
FOR
SET DATE=$ORDER(^PXRMINDX(FNUM,"PI",+$GET(DFN),ITEM,DATE))
if DATE<1
QUIT
Begin DoDot:2
+4 if DATE<HMPSTART
QUIT
if DATE>HMPSTOP
QUIT
SET IDT=9999999-DATE
+5 SET DA=0
FOR
SET DA=$ORDER(^PXRMINDX(FNUM,"PI",+$GET(DFN),ITEM,DATE,DA))
if DA<1
QUIT
SET ^TMP("HMPPX",$JOB,IDT,DA)=ITEM_U_DATE
End DoDot:2
End DoDot:1
+6 QUIT
PPI ; from ^PXRMINDX(FNUM,"PPI",DFN,TYPE,ITEM,DATE,DA)
+1 SET TYPE=""
FOR
SET TYPE=$ORDER(^PXRMINDX(FNUM,"PPI",+$GET(DFN),TYPE))
if TYPE=""
QUIT
Begin DoDot:1
+2 SET ITEM=0
FOR
SET ITEM=$ORDER(^PXRMINDX(FNUM,"PPI",+$GET(DFN),TYPE,ITEM))
if ITEM<1
QUIT
Begin DoDot:2
+3 SET DATE=0
FOR
SET DATE=$ORDER(^PXRMINDX(FNUM,"PPI",+$GET(DFN),TYPE,ITEM,DATE))
if DATE<1
QUIT
Begin DoDot:3
+4 if DATE<HMPSTART
QUIT
if DATE>HMPSTOP
QUIT
SET IDT=9999999-DATE
+5 SET DA=0
FOR
SET DA=$ORDER(^PXRMINDX(FNUM,"PPI",+$GET(DFN),TYPE,ITEM,DATE,DA))
if DA<1
QUIT
SET ^TMP("HMPPX",$JOB,IDT,DA)=ITEM_U_DATE
End DoDot:3
End DoDot:2
End DoDot:1
+6 ;
if FNUM=9000010.18
QUIT
+7 ;for POV also check ICD10 CODES
+8 SET TYPE=""
FOR
SET TYPE=$ORDER(^PXRMINDX(FNUM,"10D","PPI",+$GET(DFN),TYPE))
if TYPE=""
QUIT
Begin DoDot:1
+9 SET ITEM=""
FOR
SET ITEM=$ORDER(^PXRMINDX(FNUM,"10D","PPI",+$GET(DFN),TYPE,ITEM))
if ITEM=""
QUIT
Begin DoDot:2
+10 SET DATE=0
FOR
SET DATE=$ORDER(^PXRMINDX(FNUM,"10D","PPI",+$GET(DFN),TYPE,ITEM,DATE))
if DATE<1
QUIT
Begin DoDot:3
+11 if DATE<HMPSTART
QUIT
if DATE>HMPSTOP
QUIT
SET IDT=9999999-DATE
+12 SET DA=0
FOR
SET DA=$ORDER(^PXRMINDX(FNUM,"10D","PPI",+$GET(DFN),TYPE,ITEM,DATE,DA))
if DA<1
QUIT
SET ^TMP("HMPPX",$JOB,IDT,DA)=ITEM_U_DATE
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
PTF ; from ^PXRMINDX(45,"ICD9","PNI",DFN,TYPE,ITEM,DATE,DA)
+1 ;Purpose - Build ^TMP("HMPPX") from ^PXRMINDX(45,HMPISYS,"PNI",DFN)
+2 ;
+3 ;Called by - PTF^HMPDJ0 (if HMPID is not set)
+4 ;
+5 ;Assumptions -
+6 ;1. DFN, HMPSTART and HMPSTOP variables have been set in prior code
+7 ;2. ^TMP("HMPPX") does not exist and needs to be built
+8 ;3. '$G(HMPID)
+9 ;
+10 ;Modification History -
+11 ;US5630 (TW) - HMPISYS can be either "ICD" or "10D" (ICD-10)
+12 ;
+13 NEW HMPISYS,HMPTYP,HMPDX,HMPDT,HMPITEM,HMPRDT
+14 SET HMPISYS=""
FOR
SET HMPISYS=$ORDER(^PXRMINDX(45,HMPISYS))
if HMPISYS=""
QUIT
Begin DoDot:1
+15 if '$DATA(^PXRMINDX(45,HMPISYS,"PNI",+$GET(DFN)))
QUIT
+16 SET HMPTYP=""
FOR
SET HMPTYP=$ORDER(^PXRMINDX(45,HMPISYS,"PNI",+$GET(DFN),HMPTYP))
if HMPTYP=""
QUIT
Begin DoDot:2
+17 SET HMPDX=0
FOR
SET HMPDX=$ORDER(^PXRMINDX(45,HMPISYS,"PNI",+$GET(DFN),HMPTYP,HMPDX))
if HMPDX=""
QUIT
Begin DoDot:3
+18 SET HMPDT=0
FOR
SET HMPDT=$ORDER(^PXRMINDX(45,HMPISYS,"PNI",+$GET(DFN),HMPTYP,HMPDX,HMPDT))
if HMPDT<1
QUIT
Begin DoDot:4
+19 if HMPDT<HMPSTART
QUIT
if HMPDT>HMPSTOP
QUIT
SET HMPRDT=9999999-HMPDT
+20 SET HMPITEM=""
FOR
SET HMPITEM=$ORDER(^PXRMINDX(45,HMPISYS,"PNI",+$GET(DFN),HMPTYP,HMPDX,HMPDT,HMPITEM))
if HMPITEM=""
QUIT
SET ^TMP("HMPPX",$JOB,HMPRDT,HMPITEM_";"_HMPTYP)=HMPDX_U_HMPDT_U_HMPISYS
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
VIML(LOT,IMDATA) ;VIMM2.0 Return IMMUNIZATION LOT data (Lot #, Expiration Date, and Mfr. can also be in COMMENTS)
+1 NEW ARR,DATA,ERR,FILE,FLDS,FLGS,IEN
+2 ;IMMUNIZATION LOT
SET FILE=9999999.41
+3 SET IEN=LOT_","
SET FLDS=".02;.09"
SET FLGS="IE"
SET ARR="DATA"
SET ERR="ERR"
+4 DO GETS^DIQ(FILE,IEN,FLDS,FLGS,ARR,ERR)
+5 ;
+6 ; --- Expiration Date & Manufacturer
+7 SET IMDATA("EXPDATE")=$GET(DATA(FILE,IEN,.09,"I"))
+8 SET IMDATA("MANUFACTURER")=$GET(DATA(FILE,IEN,.02,"E"))
+9 QUIT
VIMM(DA,IMDATA,VISIT) ;VIMM2.0 Return data for a specified V IMMUNIZATION entry.
+1 NEW ADMIN1,ARR,DATA,ERR,FLDS,FLGS,IEN,INFO1,ROUTE1,TEMP,TMPGBL,VIS,VISIEN
+2 ; 9000010.11 - V IMMUNIZATION
+3 SET IEN=DA_","
SET FLDS=".01;.02;.03;.04;.05;.06;.07;.08;.09;.12;1101;1201;1202;1203;1204;1205;1206;1207;1301;1302;1303;1312;1313;80101;80102;81101;81201;81202;81203;2*"
+4 SET FLGS="IE"
SET ARR="DATA"
SET ERR="ERR"
+5 DO GETS^DIQ(9000010.11,IEN,FLDS,FLGS,ARR,ERR)
+6 ;
+7 ; Immunization Code
+8 ;US14129 - This line was causing VIMIMM to be sent the vaccine *name* not IEN. Had to fix it for the story.
+9 SET IMDATA("IMMCODE")=$GET(DATA(9000010.11,IEN,.01,"I"))
+10 ;
+11 ; Dosage & Units
+12 SET IMDATA("DOSE")=$GET(DATA(9000010.11,IEN,1312,"E"))
+13 SET IMDATA("DOSEUNITS")=$GET(DATA(9000010.11,IEN,1313,"E"))
+14 ;
+15 ; Lot Number
+16 SET IMDATA("LOTNUMBER")=$GET(DATA(9000010.11,IEN,1207,"E"))
+17 ;
+18 ; Ordering Provider
+19 SET IMDATA("ORDPRV")=$GET(DATA(9000010.11,IEN,1202,"E"))
+20 ;
+21 ; Admin / Encounter Provuder
+22 SET IMDATA("ADMNPRV")=$GET(DATA(9000010.11,IEN,1204,"E"))
+23 ;
+24 ; Event Date and Time
+25 SET IMDATA("EVNTDAT")=$GET(DATA(9000010.11,IEN,1201,"I"))
+26 ;
+27 ; Remarks
+28 ; DE3454 - added logic for word processing field data - HM
+29 NEW CT,X,WP,COUNT
+30 SET X=$$GET1^DIQ(9000010.11,IEN,1101,"","WP")
SET COUNT=0
+31 IF $DATA(WP(1))
SET CT=""
Begin DoDot:1
+32 FOR
SET CT=$ORDER(WP(CT))
if CT=""
QUIT
SET COUNT=COUNT+1
End DoDot:1
+33 IF COUNT>0
SET IMDATA("REMARKS")=""
SET CT=""
Begin DoDot:1
+34 FOR
SET CT=$ORDER(WP(CT))
if CT=""
QUIT
Begin DoDot:2
+35 SET IMDATA("REMARKS")=$SELECT(CT'=COUNT:IMDATA("REMARKS")_WP(CT)_" "_$CHAR(13)_$CHAR(10),CT=COUNT:IMDATA("REMARKS")_WP(CT),1:0)
End DoDot:2
End DoDot:1
+36 ;
+37 ; Comments
+38 SET IMDATA("COMMENTS")=$GET(DATA(9000010.11,IEN,81101,"E"))
+39 ;
+40 ; Information Source
+41 SET IMDATA("INFOSRC")=$GET(DATA(9000010.11,IEN,1301,"E"))
+42 ;
+43 ; Route
+44 SET IMDATA("ROUTE")=$GET(DATA(9000010.11,IEN,1302,"E"))
+45 ;
+46 ; Administration Site
+47 SET IMDATA("ADMNSITE")=$GET(DATA(9000010.11,IEN,1303,"E"))
+48 ;
+49 ; Vaccine Information Statement (VIS)
+50 SET IMDATA("VISDAT")=$$VIMVIS(.DATA)
+51 ;US14129 - Add More VIS data to extract
+52 DO VIMVISNW(.DATA,.IMDATA)
+53 QUIT
VIMIMM(IMMCODE,IMDATA) ;VIMM2.0 Return data for an IMMUNIZATION entry.
+1 NEW ARR,DATA,ERR,FLDS,FLGS,IEN
+2 ; 9999999.14 - Immunization
+3 SET IEN=IMMCODE_","
SET FLDS=".03;2"
SET FLGS="IE"
SET ARR="DATA"
SET ERR="ERR"
+4 DO GETS^DIQ(9999999.14,IEN,FLDS,FLGS,ARR,ERR)
+5 ;
+6 ; CVX code
+7 SET IMDATA("CVXCODE")=$GET(DATA(9999999.14,IEN,.03,"E"))
+8 ; US14129 - Add cdc full vaccine name to return
+9 ; Use our existing API to format the Word Processing data for JSON
+10 DO SETTEXT^HMPUTILS($NAME(DATA(9999999.14,IEN,2)),$NAME(IMDATA("CDCNAME")))
+11 QUIT
VIMVIS(DATA) ;VIMM2.0 Return an IMMUNIZATION's VACCINE INFORMATION STATEMENT(s).
+1 NEW DT,SC,SL,VDX,VIS,VISALL,VISIEN
+2 SET (DT,VIS,VISALL,VDX)=""
SET SL="/"
SET SC=";"
+3 SET VISIEN=""
FOR
SET VISIEN=$ORDER(DATA(9000010.112,VISIEN))
if VISIEN=""
QUIT
Begin DoDot:1
+4 SET VIS=$GET(DATA(9000010.112,VISIEN,".01","E"))
+5 IF $DATA(DATA(9000010.112,VISIEN,".02","I"))
Begin DoDot:2
+6 SET DT=$GET(DATA(9000010.112,VISIEN,".02","I"))
SET DT=$EXTRACT($$JSONDT^HMPUTILS(DT)_"000000",1,14)
End DoDot:2
+7 IF $GET(DT)
IF $GET(VIS)'=""
SET VISALL(VIS_SL_DT_SC)=""
End DoDot:1
+8 ; DE3454 - added logic for word processing field data - HM
SET (VDX,VIS)=""
FOR
SET VDX=$ORDER(VISALL(VDX))
if VDX=""
QUIT
SET VIS=VIS_" "_$CHAR(13)_$CHAR(10)_VDX
+9 QUIT VIS
+10 ;
VIMVISNW(DATA,IMDATA) ;US14129 - Add VIS data to extract
+1 NEW PTVISIEN,VISIEN,IEN,LANGIEN
+2 SET PTVISIEN=""
FOR I=1:1
SET PTVISIEN=$ORDER(DATA(9000010.112,PTVISIEN))
if PTVISIEN=""
QUIT
Begin DoDot:1
+3 SET VISIEN=$GET(DATA(9000010.112,PTVISIEN,".01","I"))_","
if 'VISIEN
QUIT
+4 IF $DATA(DATA(9000010.112,PTVISIEN,".01","E"))
SET IMDATA("VIS",I,"VISNAME")=$GET(DATA(9000010.112,PTVISIEN,".01","E"))
+5 if $GET(DATA(9000010.112,PTVISIEN,".02","I"))
SET IMDATA("VIS",I,"OFFEREDDATE")=$$JSONDT^HMPUTILS(DATA(9000010.112,PTVISIEN,".02","I"))
+6 DO GETS^DIQ(920,VISIEN,".01;.02;.04","IE","DATA","ERR")
+7 if $GET(DATA(920,VISIEN,".02","I"))
SET IMDATA("VIS",I,"EDITIONDATE")=$$JSONDT^HMPUTILS(DATA(920,VISIEN,".02","I"))
+8 ;Need to pull NAME (#1), not CODE (#.01), field from language file.
+9 SET LANGIEN=$GET(DATA(920,VISIEN,".04","I"))
if LANGIEN
SET IMDATA("VIS",I,"LANGUAGE")=$$GET1^DIQ(.85,LANGIEN_",",1)
End DoDot:1
+10 QUIT
