HMPWB5 ;JD/CNP - Write back entry points for Notes, and Encounters;Jul 8, 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
;
ENC(RSLT,IEN,DFN,DATA) ; Encounters
;
;RPC: HMP WRITEBACK ENCOUNTERS
;Output
; RSLT = JSON format string for encounters
;Input
; IEN = record to be updated
; DFN = patient IEN
; DATA(0) - input format - string - Main delimiter is "^"; Subdelimiter is ";"
; 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: 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)
; DATA(n) - Encounter data - Main delimiter is "^"; Subdelimeter is ";"
; n is an integer>0. Encounter data varies with the type of encounter (piece 7 above)
; as follows:
; CPT: CPT code^Modifier1 code;Modifier2 code;...^Quantity^Provider name^Comment
; HF: Health factor name^Level/severity code^Comment
; IMM: ***N/A*** Immunization RPC will be invoked
; PED: Education name^Level of understanding code^Comment
; POV: Diag. code^Search term^EXACT "problem list items" text^Add to problem list^Comment
; SK: Skin test name^Result code^Reading^Comment
; XAM: Exam name^Result code^Comment
;
N ENC,ENCNM,ENCTL,ENCTYP,ENCGLB,ERR,GLB,HMP,HMPA,HMPFCNT,HMPE,HMPTMP
N HMPUID,INFO,NOTE,NOTEIEN,OK,ORLOC,PCELIST,PRVNM,STMPTM,VISIT,X,Y,X0,X1,X2
S U="^",HMPTMP="HMPENC",ERR="",IEN=$G(IEN)
I '$G(DFN) D MSG("DFN",1) Q ; DFN is required
;S INFO=$G(DATA(0)) ;1
S INFO=$G(DATA) ;2
;Check for required fields
; DFN
S HMP="DFN"
I '$P(INFO,U) D MSG(HMP,1) Q
I $D(^DPT($P(INFO,U)))'>0 D MSG(HMP,2,$P(INFO,U)) Q
; Location
S HMP="Location IEN"
I '$P(INFO,U,3) D MSG(HMP,1) Q
I $D(^SC($P(INFO,U,3)))'>0 D MSG(HMP,2,$P(INFO,U,3)) Q
; Visit Date
I '$P(INFO,U,4) D MSG("Visit Date",1) Q
;;Service Category
I $L($P(INFO,U,5))=0 D MSG("Service category",1) Q
; Encouter Type
I $L($P(INFO,U,7))=0 D MSG("Encounter type",1) Q
;
;If the encounter is immunization then call the immunization RPC.
I $P(INFO,U,7)="IMM" D Q
.;S DATA=DATA(0)_U_DATA(1) ;1
.D IMMUN^HMPWBIM1(.RSLT,IEN,DFN,.DATA)
;
S DFN=$P(INFO,U),OK="",NOTEIEN=0,ORLOC=$P(INFO,U,3)
S ENCTYP=$$UP^XLFSTR($P(INFO,U,7))
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("Encounter type",2,ENCTYP) Q ; Invalid encounter type
;S ENCNM=$P($G(@ENCGLB@($P(INFO,U,8),0)),U) ; Encounter name
S PRVNM=$P($G(^VA(200,$P(INFO,U,6),0)),U) ; Provider name
;Prepare the 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 ERR=""
S DATA(1)=$P(INFO,U,8,999) ;2
D PCELST^HMPWB5A(ENCTYP,.DATA,.PCELIST,.ERR)
I $G(ERR)]"" D MSG(ERR) Q
;Invoke the already existing RPC (ORWPCE SAVE)
;D SAVE^ORWPCE(.OK,.PCELIST,NOTEIEN,ORLOC)
D DQSAVE^ORWPCE1
;S VISIT=$O(^AUPNVSIT("B",$P(INFO,U,4),""))
S HMP=""
F S HMP=$O(^AUPNVSIT("B",$P(INFO,U,4),HMP)) Q:HMP="" Q:DFN=$P(^AUPNVSIT(HMP,0),"^",5)
S VISIT=HMP
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)
.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
..D GET^HMPDJ(.HMP,.FILTER)
.S GLB="^AUPNV"_ENCTYP
.S ENC=$O(@GLB@("AD",VISIT,""))
.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)
..;Build Metastamp and Syncstatus
..S HMPFCNT=$G(^TMP("HMPF",$J,"total"))
..S HMPUID=$$SETUID^HMPUTILS(ENCTL,DFN,ENC)
..S HMPE=$G(^TMP("HMP",$J,1,1))
..S STMPTM=$TR($P($P(HMPE,"stampTime",2),","),""":")
..D ADHOC^HMPUTIL2(ENCTL,HMPFCNT,DFN,HMPUID,STMPTM)
..K ^TMP(HMPTMP,$J)
..;=== Add a } to the end of data
..; Find the 'data' section in ^TMP("HMPF"
..S X0=0
..F S X0=$O(^TMP("HMPF",$J,X0)) Q:X0'=+X0 D
...S X1=0
...F S X1=$O(^TMP("HMPF",$J,X0,X1)) Q:X1'=+X1 D
....S X2=$G(^TMP("HMPF",$J,X0,X1))
....I X2[("""collection"""_":"_""""_ENCTL_"""") M ^TMP(HMPTMP,$J,X0)=^TMP("HMPF",$J,X0)
..; Add } to the end
..S X0=0
..F S X0=$O(^TMP(HMPTMP,$J,X0)) Q:X0'=+X0 D
...S X1=$O(^TMP(HMPTMP,$J,X0,""),-1)
...S ^TMP(HMPTMP,$J,X0,X1)=^TMP(HMPTMP,$J,X0,X1)_"}"
..;===
..K RSLT
..S RSLT=$NA(^TMP(HMPTMP,$J))
.I ENC'>0 D MSG("Encounter was not created")
Q
;
MSG(M,Q,V) ;
;Create a message (M) in JSON format with a qualifier (Q)
; M - Message text
; Q - Qualifier:
; 1 - Required
; 2 - Invalid
; V - If Q=1, then V is ignored (or not passed in)
; If Q=2, then V=<the invalid value>
S M=$G(M),Q=$G(Q),V=$G(V)
D MSG^HMPTOOLS(M,Q,V) ; Returns RSLT(1)
K ^TMP(HMPTMP,$J)
M ^TMP(HMPTMP,$J)=RSLT(1)
K RSLT
S RSLT=$NA(^TMP(HMPTMP,$J))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPWB5 6297 printed Apr 09, 2024@20:58:34 Page 2
HMPWB5 ;JD/CNP - Write back entry points for Notes, and Encounters;Jul 8, 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 ;
ENC(RSLT,IEN,DFN,DATA) ; Encounters
+1 ;
+2 ;RPC: HMP WRITEBACK ENCOUNTERS
+3 ;Output
+4 ; RSLT = JSON format string for encounters
+5 ;Input
+6 ; IEN = record to be updated
+7 ; DFN = patient IEN
+8 ; DATA(0) - input format - string - Main delimiter is "^"; Subdelimiter is ";"
+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: 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 ; DATA(n) - Encounter data - Main delimiter is "^"; Subdelimeter is ";"
+24 ; n is an integer>0. Encounter data varies with the type of encounter (piece 7 above)
+25 ; as follows:
+26 ; CPT: CPT code^Modifier1 code;Modifier2 code;...^Quantity^Provider name^Comment
+27 ; HF: Health factor name^Level/severity code^Comment
+28 ; IMM: ***N/A*** Immunization RPC will be invoked
+29 ; PED: Education name^Level of understanding code^Comment
+30 ; POV: Diag. code^Search term^EXACT "problem list items" text^Add to problem list^Comment
+31 ; SK: Skin test name^Result code^Reading^Comment
+32 ; XAM: Exam name^Result code^Comment
+33 ;
+34 NEW ENC,ENCNM,ENCTL,ENCTYP,ENCGLB,ERR,GLB,HMP,HMPA,HMPFCNT,HMPE,HMPTMP
+35 NEW HMPUID,INFO,NOTE,NOTEIEN,OK,ORLOC,PCELIST,PRVNM,STMPTM,VISIT,X,Y,X0,X1,X2
+36 SET U="^"
SET HMPTMP="HMPENC"
SET ERR=""
SET IEN=$GET(IEN)
+37 ; DFN is required
IF '$GET(DFN)
DO MSG("DFN",1)
QUIT
+38 ;S INFO=$G(DATA(0)) ;1
+39 ;2
SET INFO=$GET(DATA)
+40 ;Check for required fields
+41 ; DFN
+42 SET HMP="DFN"
+43 IF '$PIECE(INFO,U)
DO MSG(HMP,1)
QUIT
+44 IF $DATA(^DPT($PIECE(INFO,U)))'>0
DO MSG(HMP,2,$PIECE(INFO,U))
QUIT
+45 ; Location
+46 SET HMP="Location IEN"
+47 IF '$PIECE(INFO,U,3)
DO MSG(HMP,1)
QUIT
+48 IF $DATA(^SC($PIECE(INFO,U,3)))'>0
DO MSG(HMP,2,$PIECE(INFO,U,3))
QUIT
+49 ; Visit Date
+50 IF '$PIECE(INFO,U,4)
DO MSG("Visit Date",1)
QUIT
+51 ;;Service Category
+52 IF $LENGTH($PIECE(INFO,U,5))=0
DO MSG("Service category",1)
QUIT
+53 ; Encouter Type
+54 IF $LENGTH($PIECE(INFO,U,7))=0
DO MSG("Encounter type",1)
QUIT
+55 ;
+56 ;If the encounter is immunization then call the immunization RPC.
+57 IF $PIECE(INFO,U,7)="IMM"
Begin DoDot:1
+58 ;S DATA=DATA(0)_U_DATA(1) ;1
+59 DO IMMUN^HMPWBIM1(.RSLT,IEN,DFN,.DATA)
End DoDot:1
QUIT
+60 ;
+61 SET DFN=$PIECE(INFO,U)
SET OK=""
SET NOTEIEN=0
SET ORLOC=$PIECE(INFO,U,3)
+62 SET ENCTYP=$$UP^XLFSTR($PIECE(INFO,U,7))
+63 SET ENCGLB=$SELECT(ENCTYP="CPT":"^ICPT",ENCTYP="POV":"^ICD9",1:"MORE")
+64 IF ENCGLB="MORE"
SET ENCGLB=$SELECT(ENCTYP="PED":"^AUTTEDT",ENCTYP="XAM":"^AUTTEXAM",1:"MORE")
+65 IF ENCGLB="MORE"
SET ENCGLB="^AUTT"_ENCTYP
+66 ; Invalid encounter type
IF $DATA(@ENCGLB)'>0
DO MSG("Encounter type",2,ENCTYP)
QUIT
+67 ;S ENCNM=$P($G(@ENCGLB@($P(INFO,U,8),0)),U) ; Encounter name
+68 ; Provider name
SET PRVNM=$PIECE($GET(^VA(200,$PIECE(INFO,U,6),0)),U)
+69 ;Prepare the encounter array for the RPC
+70 SET PCELIST(1)="HDR^"_$PIECE(INFO,U,2)_"^^"_$PIECE(INFO,U,3)_";"_$PIECE(INFO,U,4)_";"_$PIECE(INFO,U,5)
+71 SET PCELIST(2)="VST^DT^"_$PIECE(INFO,U,4)
+72 SET PCELIST(3)="VST^PT^"_$PIECE(INFO,U)
+73 SET PCELIST(4)="VST^HL^"_$PIECE(INFO,U,3)
+74 SET PCELIST(5)="VST^VC^"_$PIECE(INFO,U,5)
+75 SET PCELIST(6)="PRV^"_$PIECE(INFO,U,6)_"^^^"_PRVNM_"^1"
+76 SET ERR=""
+77 ;2
SET DATA(1)=$PIECE(INFO,U,8,999)
+78 DO PCELST^HMPWB5A(ENCTYP,.DATA,.PCELIST,.ERR)
+79 IF $GET(ERR)]""
DO MSG(ERR)
QUIT
+80 ;Invoke the already existing RPC (ORWPCE SAVE)
+81 ;D SAVE^ORWPCE(.OK,.PCELIST,NOTEIEN,ORLOC)
+82 DO DQSAVE^ORWPCE1
+83 ;S VISIT=$O(^AUPNVSIT("B",$P(INFO,U,4),""))
+84 SET HMP=""
+85 FOR
SET HMP=$ORDER(^AUPNVSIT("B",$PIECE(INFO,U,4),HMP))
if HMP=""
QUIT
if DFN=$PIECE(^AUPNVSIT(HMP,0),"^",5)
QUIT
+86 SET VISIT=HMP
+87 IF VISIT>0
Begin DoDot:1
+88 KILL FILTER
+89 SET FILTER("noHead")=1
+90 SET FILTER("patientId")=DFN
+91 SET FILTER("domain")="visit"
+92 SET FILTER("id")=VISIT
+93 DO GET^HMPDJ(.HMP,.FILTER)
+94 SET NOTE=$ORDER(^TIU(8925,"V",VISIT,""))
+95 IF NOTE>0
Begin DoDot:2
+96 KILL FILTER
+97 SET FILTER("noHead")=1
+98 SET FILTER("patientId")=DFN
+99 SET FILTER("domain")="document"
+100 SET FILTER("id")=OK
+101 DO GET^HMPDJ(.HMP,.FILTER)
End DoDot:2
+102 SET GLB="^AUPNV"_ENCTYP
+103 SET ENC=$ORDER(@GLB@("AD",VISIT,""))
+104 IF ENC>0
Begin DoDot:2
+105 ; Get the full domain name so it matches the tags in HMPDJ0
+106 SET ENCTL=$SELECT(ENCTYP="CPT":"cpt",ENCTYP="HF":"factor",ENCTYP="IMM":"immuniza",1:"MORE")
+107 IF ENCTL="MORE"
SET ENCTL=$SELECT(ENCTYP="PED":"educatio",ENCTYP="POV":"pov",1:"MORE")
+108 IF ENCTL="MORE"
SET ENCTL=$SELECT(ENCTYP="SK":"skin",ENCTYP="XAM":"exam",1:"")
+109 KILL FILTER
+110 SET FILTER("noHead")=1
+111 SET FILTER("patientId")=DFN
+112 SET FILTER("domain")=ENCTL
+113 SET FILTER("id")=ENC
+114 DO GET^HMPDJ(.HMP,.FILTER)
+115 ;Build Metastamp and Syncstatus
+116 SET HMPFCNT=$GET(^TMP("HMPF",$JOB,"total"))
+117 SET HMPUID=$$SETUID^HMPUTILS(ENCTL,DFN,ENC)
+118 SET HMPE=$GET(^TMP("HMP",$JOB,1,1))
+119 SET STMPTM=$TRANSLATE($PIECE($PIECE(HMPE,"stampTime",2),","),""":")
+120 DO ADHOC^HMPUTIL2(ENCTL,HMPFCNT,DFN,HMPUID,STMPTM)
+121 KILL ^TMP(HMPTMP,$JOB)
+122 ;=== Add a } to the end of data
+123 ; Find the 'data' section in ^TMP("HMPF"
+124 SET X0=0
+125 FOR
SET X0=$ORDER(^TMP("HMPF",$JOB,X0))
if X0'=+X0
QUIT
Begin DoDot:3
+126 SET X1=0
+127 FOR
SET X1=$ORDER(^TMP("HMPF",$JOB,X0,X1))
if X1'=+X1
QUIT
Begin DoDot:4
+128 SET X2=$GET(^TMP("HMPF",$JOB,X0,X1))
+129 IF X2[("""collection"""_":"_""""_ENCTL_"""")
MERGE ^TMP(HMPTMP,$JOB,X0)=^TMP("HMPF",$JOB,X0)
End DoDot:4
End DoDot:3
+130 ; Add } to the end
+131 SET X0=0
+132 FOR
SET X0=$ORDER(^TMP(HMPTMP,$JOB,X0))
if X0'=+X0
QUIT
Begin DoDot:3
+133 SET X1=$ORDER(^TMP(HMPTMP,$JOB,X0,""),-1)
+134 SET ^TMP(HMPTMP,$JOB,X0,X1)=^TMP(HMPTMP,$JOB,X0,X1)_"}"
End DoDot:3
+135 ;===
+136 KILL RSLT
+137 SET RSLT=$NAME(^TMP(HMPTMP,$JOB))
End DoDot:2
+138 IF ENC'>0
DO MSG("Encounter was not created")
End DoDot:1
+139 QUIT
+140 ;
MSG(M,Q,V) ;
+1 ;Create a message (M) in JSON format with a qualifier (Q)
+2 ; M - Message text
+3 ; Q - Qualifier:
+4 ; 1 - Required
+5 ; 2 - Invalid
+6 ; V - If Q=1, then V is ignored (or not passed in)
+7 ; If Q=2, then V=<the invalid value>
+8 SET M=$GET(M)
SET Q=$GET(Q)
SET V=$GET(V)
+9 ; Returns RSLT(1)
DO MSG^HMPTOOLS(M,Q,V)
+10 KILL ^TMP(HMPTMP,$JOB)
+11 MERGE ^TMP(HMPTMP,$JOB)=RSLT(1)
+12 KILL RSLT
+13 SET RSLT=$NAME(^TMP(HMPTMP,$JOB))
+14 QUIT
