Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HMPWB5

HMPWB5.m

Go to the documentation of this file. 
  1. 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
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. ENC(RSLT,IEN,DFN,DATA) ; Encounters
  1.  ;
  1.  ;RPC: HMP WRITEBACK ENCOUNTERS
  1.  ;Output
  1.  ; RSLT = JSON format string for encounters
  1.  ;Input
  1.  ; IEN  = record to be updated
  1.  ; DFN  = patient IEN
  1.  ; DATA(0) - input format - string - Main delimiter is "^"; Subdelimiter is ";"
  1.  ;   Piece 1: DFN - Patient IEN
  1.  ;   Piece 2: Inpatient flag - 1 = inpatient, 0 = otherwise
  1.  ;   Piece 3: Hospital location IEN
  1.  ;   Piece 4: Visit/episode date
  1.  ;   Piece 5: Service category
  1.  ;   Piece 6: Author/dictator IEN (i.e. Provider)
  1.  ;   Piece 7: Encounter type - A 2- or 3-character string as follows:
  1.  ;               CPT for CPT (^AUPNVCPT; #9000010.18)
  1.  ;               HF      Health Factor (^AUPNVHF; #9000010.23)
  1.  ;               IMM     Immunization (^AUPNVIMM; #9000010.11)
  1.  ;               PED     Patient Education (^AUPNVPED; #9000010.16)
  1.  ;               POV     POV - Purpose of Visit; a.k.a Diagnosis - (^AUPNVPOV; #9000010.07)
  1.  ;               SK      Skin (^AUPNVSK; #9000010.12)
  1.  ;               XAM     Exam (^AUPNVXAM; #9000010.13)
  1.  ; DATA(n) - Encounter data - Main delimiter is "^"; Subdelimeter is ";"
  1.  ;  n is an integer>0.  Encounter data varies with the type of encounter (piece 7 above)
  1.  ;  as follows:
  1.  ;   CPT: CPT code^Modifier1 code;Modifier2 code;...^Quantity^Provider name^Comment
  1.  ;    HF: Health factor name^Level/severity code^Comment
  1.  ;   IMM: ***N/A***  Immunization RPC will be invoked
  1.  ;   PED: Education name^Level of understanding code^Comment
  1.  ;   POV: Diag. code^Search term^EXACT "problem list items" text^Add to problem list^Comment
  1.  ;    SK: Skin test name^Result code^Reading^Comment
  1.  ;   XAM: Exam name^Result code^Comment
  1.  ;
  1.  N ENC,ENCNM,ENCTL,ENCTYP,ENCGLB,ERR,GLB,HMP,HMPA,HMPFCNT,HMPE,HMPTMP
  1.  N HMPUID,INFO,NOTE,NOTEIEN,OK,ORLOC,PCELIST,PRVNM,STMPTM,VISIT,X,Y,X0,X1,X2
  1.  S U="^",HMPTMP="HMPENC",ERR="",IEN=$G(IEN)
  1.  I '$G(DFN) D MSG("DFN",1) Q  ; DFN is required
  1.  ;S INFO=$G(DATA(0))  ;1
  1.  S INFO=$G(DATA)     ;2
  1.  ;Check for required fields
  1.  ; DFN
  1.  S HMP="DFN"
  1.  I '$P(INFO,U) D MSG(HMP,1) Q
  1.  I $D(^DPT($P(INFO,U)))'>0 D MSG(HMP,2,$P(INFO,U)) Q
  1.  ; Location
  1.  S HMP="Location IEN"
  1.  I '$P(INFO,U,3) D MSG(HMP,1) Q
  1.  I $D(^SC($P(INFO,U,3)))'>0 D MSG(HMP,2,$P(INFO,U,3)) Q
  1.  ; Visit Date
  1.  I '$P(INFO,U,4) D MSG("Visit Date",1) Q
  1.  ;;Service Category
  1.  I $L($P(INFO,U,5))=0 D MSG("Service category",1) Q
  1.  ; Encouter Type
  1.  I $L($P(INFO,U,7))=0 D MSG("Encounter type",1) Q
  1.  ;
  1.  ;If the encounter is immunization then call the immunization RPC.
  1.  I $P(INFO,U,7)="IMM" D  Q
  1.  .;S DATA=DATA(0)_U_DATA(1)  ;1
  1.  .D IMMUN^HMPWBIM1(.RSLT,IEN,DFN,.DATA)
  1.  ;
  1.  S DFN=$P(INFO,U),OK="",NOTEIEN=0,ORLOC=$P(INFO,U,3)
  1.  S ENCTYP=$$UP^XLFSTR($P(INFO,U,7))
  1.  S ENCGLB=$S(ENCTYP="CPT":"^ICPT",ENCTYP="POV":"^ICD9",1:"MORE")
  1.  I ENCGLB="MORE" S ENCGLB=$S(ENCTYP="PED":"^AUTTEDT",ENCTYP="XAM":"^AUTTEXAM",1:"MORE")
  1.  I ENCGLB="MORE" S ENCGLB="^AUTT"_ENCTYP
  1.  I $D(@ENCGLB)'>0 D MSG("Encounter type",2,ENCTYP) Q  ; Invalid encounter type
  1.  ;S ENCNM=$P($G(@ENCGLB@($P(INFO,U,8),0)),U)  ; Encounter name
  1.  S PRVNM=$P($G(^VA(200,$P(INFO,U,6),0)),U)   ; Provider name
  1.  ;Prepare the encounter array for the RPC
  1.  S PCELIST(1)="HDR^"_$P(INFO,U,2)_"^^"_$P(INFO,U,3)_";"_$P(INFO,U,4)_";"_$P(INFO,U,5)
  1.  S PCELIST(2)="VST^DT^"_$P(INFO,U,4)
  1.  S PCELIST(3)="VST^PT^"_$P(INFO,U)
  1.  S PCELIST(4)="VST^HL^"_$P(INFO,U,3)
  1.  S PCELIST(5)="VST^VC^"_$P(INFO,U,5)
  1.  S PCELIST(6)="PRV^"_$P(INFO,U,6)_"^^^"_PRVNM_"^1"
  1.  S ERR=""
  1.  S DATA(1)=$P(INFO,U,8,999)  ;2
  1.  D PCELST^HMPWB5A(ENCTYP,.DATA,.PCELIST,.ERR)
  1.  I $G(ERR)]"" D MSG(ERR) Q
  1.  ;Invoke the already existing RPC (ORWPCE SAVE)
  1.  ;D SAVE^ORWPCE(.OK,.PCELIST,NOTEIEN,ORLOC)
  1.  D DQSAVE^ORWPCE1
  1.  ;S VISIT=$O(^AUPNVSIT("B",$P(INFO,U,4),""))
  1.  S HMP=""
  1.  F  S HMP=$O(^AUPNVSIT("B",$P(INFO,U,4),HMP)) Q:HMP=""  Q:DFN=$P(^AUPNVSIT(HMP,0),"^",5)
  1.  S VISIT=HMP
  1.  I VISIT>0 D
  1.  .K FILTER
  1.  .S FILTER("noHead")=1
  1.  .S FILTER("patientId")=DFN
  1.  .S FILTER("domain")="visit"
  1.  .S FILTER("id")=VISIT
  1.  .D GET^HMPDJ(.HMP,.FILTER)
  1.  .S NOTE=$O(^TIU(8925,"V",VISIT,""))
  1.  .I NOTE>0 D
  1.  ..K FILTER
  1.  ..S FILTER("noHead")=1
  1.  ..S FILTER("patientId")=DFN
  1.  ..S FILTER("domain")="document"
  1.  ..S FILTER("id")=OK
  1.  ..D GET^HMPDJ(.HMP,.FILTER)
  1.  .S GLB="^AUPNV"_ENCTYP
  1.  .S ENC=$O(@GLB@("AD",VISIT,""))
  1.  .I ENC>0 D
  1.  ..; Get the full domain name so it matches the tags in HMPDJ0
  1.  ..S ENCTL=$S(ENCTYP="CPT":"cpt",ENCTYP="HF":"factor",ENCTYP="IMM":"immuniza",1:"MORE")
  1.  ..I ENCTL="MORE" S ENCTL=$S(ENCTYP="PED":"educatio",ENCTYP="POV":"pov",1:"MORE")
  1.  ..I ENCTL="MORE" S ENCTL=$S(ENCTYP="SK":"skin",ENCTYP="XAM":"exam",1:"")
  1.  ..K FILTER
  1.  ..S FILTER("noHead")=1
  1.  ..S FILTER("patientId")=DFN
  1.  ..S FILTER("domain")=ENCTL
  1.  ..S FILTER("id")=ENC
  1.  ..D GET^HMPDJ(.HMP,.FILTER)
  1.  ..;Build Metastamp and Syncstatus
  1.  ..S HMPFCNT=$G(^TMP("HMPF",$J,"total"))
  1.  ..S HMPUID=$$SETUID^HMPUTILS(ENCTL,DFN,ENC)
  1.  ..S HMPE=$G(^TMP("HMP",$J,1,1))
  1.  ..S STMPTM=$TR($P($P(HMPE,"stampTime",2),","),""":")
  1.  ..D ADHOC^HMPUTIL2(ENCTL,HMPFCNT,DFN,HMPUID,STMPTM)
  1.  ..K ^TMP(HMPTMP,$J)
  1.  ..;=== Add a } to the end of data
  1.  ..; Find the 'data' section in ^TMP("HMPF"
  1.  ..S X0=0
  1.  ..F  S X0=$O(^TMP("HMPF",$J,X0)) Q:X0'=+X0  D
  1.  ...S X1=0
  1.  ...F  S X1=$O(^TMP("HMPF",$J,X0,X1)) Q:X1'=+X1  D
  1.  ....S X2=$G(^TMP("HMPF",$J,X0,X1))
  1.  ....I X2[("""collection"""_":"_""""_ENCTL_"""") M ^TMP(HMPTMP,$J,X0)=^TMP("HMPF",$J,X0)
  1.  ..; Add } to the end
  1.  ..S X0=0
  1.  ..F  S X0=$O(^TMP(HMPTMP,$J,X0)) Q:X0'=+X0  D
  1.  ...S X1=$O(^TMP(HMPTMP,$J,X0,""),-1)
  1.  ...S ^TMP(HMPTMP,$J,X0,X1)=^TMP(HMPTMP,$J,X0,X1)_"}"
  1.  ..;===
  1.  ..K RSLT
  1.  ..S RSLT=$NA(^TMP(HMPTMP,$J))
  1.  .I ENC'>0 D MSG("Encounter was not created")
  1.  Q
  1.  ;
  1. MSG(M,Q,V) ;
  1.  ;Create a message (M) in JSON format with a qualifier (Q)
  1.  ; M - Message text
  1.  ; Q - Qualifier:
  1.  ;        1 - Required
  1.  ;        2 - Invalid
  1.  ; V - If Q=1, then V is ignored (or not passed in)
  1.  ;     If Q=2, then V=<the invalid value>
  1.  S M=$G(M),Q=$G(Q),V=$G(V)
  1.  D MSG^HMPTOOLS(M,Q,V)  ; Returns RSLT(1)
  1.  K ^TMP(HMPTMP,$J)
  1.  M ^TMP(HMPTMP,$J)=RSLT(1)
  1.  K RSLT
  1.  S RSLT=$NA(^TMP(HMPTMP,$J))
  1.  Q