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

HMPEVNT.m

Go to the documentation of this file.
  1. HMPEVNT ;SLC/MKB,ASMR/JD,RRB,CPC,MBS -- VistA event listeners;Aug 29, 2016 20:06:27
  1. ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2,3**;May 15, 2016;Build 15
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; External References DBIA#
  1. ; ------------------- -----
  1. ; DG FIELD MONITOR 3344
  1. ; DGPM MOVEMENT EVENTS 1181
  1. ; GMRA ENTERED IN ERROR 1467
  1. ; GMRA SIGN-OFF ON DATA 1469
  1. ; GMRC EVSEND OR 3140
  1. ; LR70 CH EVSEND OR 6087
  1. ; MDC OBSERVATION UPDATE 6084
  1. ; PS EVSEND OR 2415
  1. ; PSB EVSEND HMP 6085
  1. ; PXK VISIT DATA EVENT 1298
  1. ; RA EVSEND OR 6086
  1. ; SDAM APPOINTMENT EVENTS 1320
  1. ; ^AUPNVSIT 2028
  1. ; ^DPT 10035
  1. ; ^OR(100 5771
  1. ; DIQ 2056
  1. ; GMVUTL 5046
  1. ; TIUSRVLO 2834
  1. ; VADPT 10061
  1. ; VASITE 10112
  1. ; XLFDT 10103
  1. ; XTHC10 5515
  1. ; ORDRNUM^PSSUTLA2 6426 ;DE6363 - JD - 8/23/16
  1. ;
  1. ; DE2818 - SQA findings.
  1. ; 1) Correct unkilled variables by modifying line tags to accept variables as
  1. ; parameters and modifying associated protocol routine calls to pass variables
  1. ; as parameters. RRB - 10/28/2015
  1. ;
  1. ;Oct 15, 2015 - PB - modified to trigger an unsolicited sync action when an order is discontinued and the patient is subscribed to eHMP
  1. ;
  1. ;DE3327 - 5/4/16 - JD - Removed the server hardcoding (hmp-development-box).
  1. ; *** NOTE ***
  1. ; It is understood that as of the date of modifying this code (5/4/16), there
  1. ; is one AND ONLY one server entry in the HMP Subscription file (#800000)
  1. ; per site. This will be fixed in future releases to accommodate multiple
  1. ; servers per site.
  1. ;
  1. Q
  1. ;
  1. DG(DGDA,DGFIELD,DGFILE) ; -- DG FIELD MONITOR protocol listener /DE2818
  1. Q:$G(DGFILE)'=2 ;Patient file only
  1. N DFN S DFN=+$G(DGDA)
  1. ; operational pt-select - *s68 BEGIN
  1. I "^.01^.02^.03^.09^.101^.351^.361^"[(U_+$G(DGFIELD)_U) D
  1. . ; -- if patient entry has been deleted, delete pt-select object
  1. . I $G(DGFIELD)=".01",'$D(^DPT(DFN)) D POSTX("pt-select",DFN,"@") Q ; *s68 - END
  1. . D POSTX("pt-select",DFN_"&"_$G(DGFIELD))
  1. ; subscribed patient
  1. I $D(^HMP(800000,"AITEM",DFN)),$$FLD(+$G(DGFIELD)) D POST(DFN,"patient",DFN)
  1. Q
  1. ;
  1. FLD(X) ; --Return 1 or 0, if X is a field tracked by HMP
  1. S X=U_+$G(X)_U
  1. I "^.01^.02^.03^.05^.08^.09^.351^.361^.364^"[X Q 1 ;demographic
  1. I "^.111^.1112^.112^.113^.114^.115^.131^.132^.134^"[X Q 1 ;addr/phone
  1. I "^.211^.212^.213^.214^.216^.217^.218^.219^"[X Q 1 ;NOK
  1. I "^.301^.302^1901^.32102^.32103^.32201^.5295^"[X Q 1 ;serv conn
  1. ;New fields. JD - 9/24/15
  1. I "^.133^"[X Q 1 ;email address
  1. I "^.1211^.1212^.1213^.1214^.1215^.1216^"[X Q 1 ;temporary address
  1. I "^.331^.332^.333^.334^.335^.336^.337^.338^.339^.33011^"[X Q 1 ;emergency contact addr/phone
  1. I "^.215^.21011^"[X Q 1 ;NOK addr line 3 and work phone
  1. I "^.3731^"[X Q 1 ;service connected conditions
  1. I "^.18^3^8^16^"[X Q 1 ;insurance
  1. Q 0
  1. ;
  1. DGPM(DGPMA,DGPMDA,DGPMP,DGPMT) ; -- DGPM MOVEMENT EVENTS protocol listener /DE2818
  1. ; [expects DFN,DGPM* variables]
  1. N ADM,ACT S ADM=DGPMDA
  1. I DGPMT'=1 S ADM=$S(DGPMA:$P(DGPMA,U,14),1:$P(DGPMP,U,14)) Q:ADM<1
  1. S ACT=$S(DGPMA:"",1:"@")
  1. I $D(^HMP(800000,"AITEM",DFN)) D POST(DFN,"visit","H"_ADM,ACT)
  1. ; update roster(s) if current movement
  1. N ADMX,MVTX,PREV,NEW,OLD,WARD
  1. S ADMX=$Q(^DGPM("ATID1",DFN)) Q:$QS(ADMX,4)'=ADM
  1. S MVTX=$Q(^DGPM("APMV",DFN,ADM)) Q:$QS(MVTX,5)'=DGPMDA
  1. S PREV=$G(DGPMP) I 'PREV,DGPMT'=1 D ;previous or edited mvt
  1. . S MVTX=$Q(@MVTX) Q:DFN'=$QS(MVTX,2) Q:ADM'=$QS(MVTX,3)
  1. . S PREV=$G(^DGPM(+$QS(MVTX,5),0))
  1. S NEW=$P(DGPMA,U,6),OLD=$P(PREV,U,6)
  1. I NEW'=OLD F WARD=NEW,OLD I WARD D
  1. . S I=0 F S I=$O(^HMPROSTR("AD",WARD_";DIC(42,",I)) Q:I<1 D POSTX("roster",I)
  1. Q
  1. ;-find visit# for corresponding admission [not used]
  1. N ADM,PTF,IDT,ID,ACT
  1. I DGPMA S ADM=+DGPMA,PTF=+$P(DGPMA,U,16)
  1. E S ADM=+DGPMP,PTF=+$P(DGPMP,U,16)
  1. I DGPMT'=1 D Q:ADM<1
  1. . N VAIP S VAIP("E")=DGPMDA
  1. . D IN5^VADPT S ADM=+VAIP(13,1),PTF=+VAIP(12)
  1. S IDT=9999999-$P(ADM,".") S:ADM["." IDT=IDT_"."_$P(ADM,".",2)
  1. S ID=+$O(^AUPNVSIT("AAH",DFN,IDT,0)) Q:'ID
  1. S ACT=$S(DGPMA:"",1:"@")
  1. D POST(DFN,"visit",ID,ACT)
  1. ; POST(DFN,"ptf",PTF,ACT):DGPMT=3
  1. Q
  1. ;
  1. NEWINPT() ; -- is DFN newly admitted?
  1. N Y S Y=0
  1. I DGPMT=1,DGPMA,'DGPMP,+$G(^DPT(DFN,.105))=DGPMDA S Y=1 ;new admission
  1. Q Y
  1. ;
  1. PCMMT(SCPTTMAF,SCPTTMB4) ; -- SCMC PATIENT TEAM CHANGES protocol listener /DE2818
  1. ;I '$P($G(SCPTTMB4),U,8),'$P($G(SCPTTMAF),U,8) Q ;not pc change ;DE5410 removed to track changes to other teams
  1. N DFN S DFN=$S($G(SCPTTMAF):+SCPTTMAF,1:+$G(SCPTTMB4)) Q:'DFN
  1. D POST(DFN,"patient",DFN)
  1. Q
  1. ;
  1. PCMMTP(SCPTTPAF,SCPTTPB4) ; -- SCMC PATIENT TEAM POSITION CHANGES protocol listener /DE2818
  1. ;I '$P($G(SCPTTPB4),U,5),'$P($G(SCPTTPAF),U,5) Q ;not pc change ;DE5410 removed to track changes to other teams
  1. N TM,DFN
  1. S TM=$S($G(SCPTTPAF):+SCPTTPAF,1:+$G(SCPTTPB4)) Q:'TM
  1. ;DE2818
  1. S DFN=$$GET1^DIQ(404.42,+TM_",",.01,"I") ;ICR 1922
  1. D POST(DFN,"patient",DFN)
  1. Q
  1. ;
  1. SDAM(SDATA) ; -- SDAM APPOINTMENT EVENTS protocol listener /DE2818
  1. I $G(SDATA)'="" D Q ;appointments ;DE5411 still process if Piece 1 not set, catches auto-rebook status
  1. . N DFN,DATE,HLOC,STS,REASON,PROV
  1. . S DFN=+$P(SDATA,U,2) I '(DFN>0) D LOGDPT^HMPLOG(DFN) Q ;DE4496 19 August 2016
  1. . Q:'$D(^HMP(800000,"AITEM",DFN))
  1. . S DATE=+$P(SDATA,U,3),HLOC=+$P(SDATA,U,4),(PROV,REASON)=""
  1. . D POST(DFN,"appointment","A;"_DATE_";"_HLOC_";"_REASON_";"_$TR($P(PROV,U,1,2),"^",";"))
  1. Q
  1. ;
  1. PCE ; -- PXK VISIT DATA EVENT protocol listener, used by HMP PCE EVENTS protocol
  1. N ACT,DA,DFN,HMPPXK,IEN,PX0A,PX0B,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK ;DE4195 and DE6485
  1. S IEN=+$O(^TMP("PXKCO",$J,0)) Q:IEN<1
  1. S PX0A=$G(^TMP("PXKCO",$J,IEN,"VST",IEN,0,"AFTER")),PX0B=$G(^("BEFORE"))
  1. S DFN=$S($L(PX0A):+$P(PX0A,U,5),1:+$P(PX0B,U,5))
  1. Q:'(DFN>0) Q:'$D(^HMP(800000,"AITEM",DFN)) ;DE4496 19 August 2016
  1. ; Visit file
  1. S ACT=$S(PX0A="":"@",1:"")
  1. ;DE4195 - put subsequent processing into taskman
  1. M HMPPXK=^TMP("PXKCO",$J)
  1. ; DE6485, add null device in ZTIO
  1. S ZTRTN="PCE2^HMPEVNT",ZTDTH=$H,ZTIO="",ZTSAVE("HMPPXK(")="",ZTSAVE("DFN")="",ZTSAVE("IEN")="",ZTSAVE("ACT")=""
  1. S ZTDESC="HMP PXK VISIT EVENT HANDLER"
  1. D ^%ZTLOAD
  1. Q
  1. PCE2 ; DE4195 - run in taskman
  1. N DA,SUB
  1. D POST(DFN,"visit",IEN,ACT)
  1. ; check V-files
  1. ;DE4879 - Removed Health Factors from loop (was SUB="HF","IMM",...)
  1. F SUB="IMM","XAM","CPT","PED","POV","SK" D
  1. . S DA=0 F S DA=$O(HMPPXK(IEN,SUB,DA)) Q:DA<1 D
  1. .. S ACT=$S($G(HMPPXK(IEN,SUB,DA,0,"AFTER"))="":"@",1:"")
  1. .. D POST(DFN,$$NAME(SUB),DA,ACT)
  1. Q
  1. ;
  1. NAME(X) ; -- return object name for V-files
  1. N Y S Y=""
  1. I X="HF" S Y="factor"
  1. I X="IMM" S Y="immunization"
  1. I X="XAM" S Y="exam"
  1. I X="CPT" S Y="cpt"
  1. I X="PED" S Y="education"
  1. I X="POV" S Y="pov"
  1. I X="SK" S Y="skin"
  1. Q Y
  1. ;
  1. ZPCE ; -- old PXK VISIT DATA EVENT protocol listener [not in use]
  1. N IEN,PX0,PX150,DFN,DA
  1. S IEN=+$O(^TMP("PXKCO",$J,0)) Q:IEN<1
  1. S PX0=$G(^TMP("PXKCO",$J,IEN,"VST",IEN,0,"AFTER")) Q:$P(PX0,U,7)="E"
  1. I PX0="" D POST(DFN,"visit",IEN,"@") Q ;deleted
  1. S PX150=$G(^TMP("PXKCO",$J,IEN,"VST",IEN,150,"AFTER")) Q:$P(PX150,U,3)'="P"
  1. S DFN=+$P(PX0,U,5) Q:'(DFN>0) Q:'$D(^HMP(800000,"AITEM",DFN)) ;DE4496 19 August 2016
  1. D POST(DFN,"visit",IEN)
  1. S DA=0 F S DA=$O(^TMP("PXKCO",$J,IEN,"IMM",DA)) Q:DA<1 D POST(DFN,"immunization",DA)
  1. S DA=0 F S DA=$O(^TMP("PXKCO",$J,IEN,"HF",DA)) Q:DA<1 D POST(DFN,"factor",DA)
  1. Q
  1. ;
  1. XQOR(MSG) ; -- messaging listener (update meds, labs, xrays, consults)
  1. N HMPMSG,HMPPKG,MSH,ORC,DFN
  1. S HMPMSG=$S($L($G(MSG)):MSG,1:"MSG") Q:'$O(@HMPMSG@(0))
  1. S MSH=0 F S MSH=$O(@HMPMSG@(MSH)) Q:MSH'>0 Q:$E(@HMPMSG@(MSH),1,3)="MSH"
  1. Q:'MSH Q:'$L($G(@HMPMSG@(MSH)))
  1. S HMPPKG=$$TYPE($P(@HMPMSG@(MSH),"|",3)) Q:'$L(HMPPKG)
  1. S DFN=$$PID Q:'(DFN>0) Q:'$D(^HMP(800000,"AITEM",DFN)) ;DE4496 19 August 2016
  1. S ORC=MSH F S ORC=$O(@HMPMSG@(+ORC)) Q:ORC'>0 I $E(@HMPMSG@(ORC),1,3)="ORC" D
  1. . N ORDCNTRL,PKGIFN,ORIFN,PORIFN
  1. . S ORC=ORC_U_@HMPMSG@(ORC),ORDCNTRL=$TR($P(ORC,"|",2),"@","P")
  1. . ; QUIT if action failed, conversion, purge, or backdoor verify/new
  1. . ;I ORDCNTRL["U"!("DE^ZC^ZP^ZR^ZV^SN"[ORDCNTRL) Q
  1. . I ORDCNTRL["U"!("DE^ZP^ZR^ZV^SN"[ORDCNTRL) Q ;Oct 15, 2015 - PB - modified to trigger an unsolicited sync action when a signed order is discontinued
  1. . S ORIFN=+$P($P(ORC,"|",3),U),PKGIFN=$P($P(ORC,"|",4),U)
  1. . ; If this is a child order get the parent and send it too
  1. . ; PORIFN = PARENT ORDER IFN
  1. . S PORIFN=+$P($G(^OR(100,ORIFN,3)),U,9)
  1. . I $$RESULT D ;update ancillary domains
  1. .. D POST(DFN,HMPPKG,PKGIFN)
  1. .. D:HMPPKG="image" POST(DFN,"document",PKGIFN)
  1. .. I HMPPKG="lab",PKGIFN'["CH",'$$LRTIU(DFN,PKGIFN) D POST(DFN,"document",$P(PKGIFN,";",4,5))
  1. . I ORIFN,ORDCNTRL'="ZD" D ;update order(s)
  1. .. D POST(DFN,"order",ORIFN)
  1. .. I PORIFN D POST(DFN,"order",PORIFN)
  1. .. N ORIG S ORIG=+$P($G(^OR(100,ORIFN,3)),U,5)
  1. .. I ORIG D POST(DFN,"order",ORIG) ;need fwd ptrs, sig flds
  1. Q
  1. ;
  1. RESULT() ; -- Return 1 or 0, if message broadcasts a result
  1. ; [may modify PKGIFN for use in POST]
  1. N Y S Y=0
  1. I HMPPKG="consult" S Y=1,PKGIFN=+PKGIFN G RQ
  1. I HMPPKG="med" S Y=1,PKGIFN=ORIFN G RQ
  1. I HMPPKG="lab" S:ORDCNTRL="RE"&($L(PKGIFN,";")>3) Y=1 G RQ
  1. I HMPPKG="image" S:PKGIFN["~" Y=1,PKGIFN=$TR($P(PKGIFN,"~",2,3),"~","-") G RQ
  1. RQ Q Y
  1. ;
  1. LRTIU(DFN,ORPK) ; -- Return 1 or 0, if LR report is in TIU
  1. I $G(DFN)<1!'$L($G(ORPK)) Q 0
  1. I ORPK["CH"!(ORPK["MI") Q 0
  1. N SUB,IDT,LRDFN
  1. S SUB=$P(ORPK,";",4),IDT=+$P(ORPK,";",5),LRDFN=+$G(^DPT(+DFN,"LR"))
  1. I $O(^LR(LRDFN,SUB,IDT,.05,0)) Q 1
  1. Q 0
  1. ;
  1. NA(MSG) ; -- messaging listener (new backdoor orders)
  1. N HMPMSG,HMPPKG,MSH,ORC,DFN
  1. S HMPMSG=$S($L($G(MSG)):MSG,1:"MSG") Q:'$O(@HMPMSG@(0))
  1. S MSH=0 F S MSH=$O(@HMPMSG@(MSH)) Q:MSH'>0 Q:$E(@HMPMSG@(MSH),1,3)="MSH"
  1. Q:'MSH Q:'$L($G(@HMPMSG@(MSH)))
  1. S HMPPKG=$$TYPE($P(@HMPMSG@(MSH),"|",5)) Q:'$L(HMPPKG)
  1. S DFN=$$PID Q:'(DFN>0) Q:'$D(^HMP(800000,"AITEM",DFN)) ;DE4496 19 August 2016
  1. S ORC=MSH F S ORC=$O(@HMPMSG@(+ORC)) Q:ORC'>0 I $E(@HMPMSG@(ORC),1,3)="ORC" D
  1. . N ORDCNTRL,ORIFN
  1. . S ORC=ORC_U_@HMPMSG@(ORC),ORDCNTRL=$TR($P(ORC,"|",2),"@","P")
  1. . Q:ORDCNTRL'="NA"
  1. . S ORIFN=+$P($P(ORC,"|",3),U) D POST(DFN,"order",ORIFN)
  1. . I HMPPKG="med" D POST(DFN,HMPPKG,ORIFN)
  1. Q
  1. ;
  1. TYPE(NAME) ; -- Returns type name for XML
  1. I NAME="LABORATORY" Q "lab"
  1. I NAME="PHARMACY" Q "med"
  1. I NAME="CONSULTS" Q "consult"
  1. I NAME="PROCEDURES" Q "consult"
  1. I NAME="RADIOLOGY" Q "image"
  1. I NAME="IMAGING" Q "image"
  1. I NAME="ORDER ENTRY" Q "order"
  1. I NAME="DIETETICS" Q "diet"
  1. Q ""
  1. ;
  1. PID() ; -- Returns patient from PID segment in current msg
  1. N I,SEG,Y S I=MSH
  1. F S I=$O(@HMPMSG@(I)) Q:I'>0 S SEG=$E(@HMPMSG@(I),1,3) Q:SEG="ORC" I SEG="PID" D Q
  1. . S Y=+$P(@HMPMSG@(I),"|",4)
  1. .;I '$D(^DPT(Y,0)) S:$L($P(@HMPMSG@(I),"|",5)) Y=+$P(@HMPMSG@(I),"|",5) ;alt ID for Lab
  1. Q Y
  1. ;
  1. PV1() ; -- Returns patient class from PV1 segment in current msg
  1. N I,SEG,Y S I=MSH,Y=""
  1. F S I=$O(@HMPMSG@(I)) Q:I'>0 S SEG=$E(@HMPMSG@(I),1,3) Q:SEG="ORC" I SEG="PV1" D Q
  1. . S Y=$P(@HMPMSG@(I),"|",3)
  1. I Y="",$G(ORIFN) S Y=$$GET1^DIQ(100,+ORIFN_",",10,"I")
  1. Q Y
  1. ;
  1. GMRA(ACT) ; -- GMRA SIGN-OFF ON DATA protocol listener
  1. ; also GMRA ENTERED IN ERROR [ACT=@]
  1. N DFN,IEN
  1. S DFN=+$G(GMRAPA(0)),IEN=+$G(GMRAPA)
  1. D POST(DFN,"allergy",IEN,$G(ACT))
  1. Q
  1. ;
  1. GMPL(DFN,IEN) ; -- GMPL EVENT protocol listener
  1. S DFN=+$G(DFN),IEN=+$G(IEN)
  1. ;N ACT S ACT=$S($P($G(^AUPNPROB(IEN,1)),U,2)="H":"@",1:"")
  1. D POST(DFN,"problem",IEN) ;,ACT)
  1. Q
  1. ;
  1. GMRV(DFN,IEN,ERR) ; -- Vital Measurement file #120.5 AHMP index
  1. S DFN=+$G(DFN),IEN=+$G(IEN)
  1. N ACT S ACT=$S($G(ERR):"@",1:"")
  1. D POST(DFN,"vital",IEN,ACT)
  1. Q
  1. ;
  1. MDC(OBS) ; -- MDC OBSERVATION UPDATE protocol listener
  1. N DFN,ID,ACT
  1. S DFN=+$G(OBS("PATIENT_ID","I")) Q:'(DFN>0) ;DE4496 19 August 2016
  1. S ID=$G(OBS("OBS_ID","I")) Q:'$L(ID)
  1. S ACT=$S('$G(OBS("STATUS","I")):"@",1:"")
  1. D POST(DFN,"obs",ID,ACT)
  1. I $G(OBS("DOMAIN","VITALS")) D POST(DFN,"vital",ID,ACT)
  1. Q
  1. ;
  1. CP(DFN,ID,ACT) ; -- CP Transaction file #702 AHMP index
  1. S DFN=+$G(DFN),ID=$G(ID)
  1. D POST(DFN,"document",ID,$G(ACT)) ;de3944 also need to generate document for procedure to link results to
  1. D POST(DFN,"procedure",ID,$G(ACT))
  1. Q
  1. ;
  1. SR(DFN,IEN,ACT) ; -- Surgery [SROERR] update
  1. S DFN=+$G(DFN),IEN=+$G(IEN)
  1. D POST(DFN,"surgery",IEN,$G(ACT))
  1. Q
  1. ;*s68 - BEGINS
  1. TIU(DFN,IEN) ; -- TIU Document file #8925 AHMP index
  1. N ACT,STS,DAD,REPCAT
  1. S DFN=+$G(DFN),IEN=+$G(IEN),ACT=""
  1. S STS=$G(X(2)),DAD=$G(X(3)) ;X = FM data array for index
  1. S:DAD IEN=DAD I 'DAD D ;if addendum, repull entire note
  1. . ;I STS=15 S ACT="@" ;retracted; DE3693 - do not delete note from JDS if retracted, March 18, 2016
  1. . I $G(X2(1))="" S ACT="@" ;deleted (new title = null)
  1. D POST(DFN,"document",IEN,ACT)
  1. ;DE3944 update surgery based on reports
  1. S REPCAT=$$CATG^HMPDTIU($$GET1^DIQ(8925,IEN_",",".01","I"))
  1. I REPCAT="SR" D
  1. . N REPCASE S REPCASE=$$GET1^DIQ(8925,IEN_",","1701","I")
  1. . S REPCASE=$P(REPCASE,"Case #: ",2)
  1. . I REPCASE D POST(DFN,"surgery",REPCASE)
  1. ;DE3241 - If TIU update changes CWADF values, trigger patient update so change get in fresh. stream
  1. ;If this note has a parent document type of "CLINICAL WARNING", "CRISIS NOTE", or "ADVANCE DIRECTIVE"...
  1. ;parent document type is "Document Class"...
  1. ;AND this note's status is COMPLETED or AMENDED
  1. ;THEN this document may update the C, W, or D CWADF values and patient fresh. stream update needs to be triggered
  1. N DADTYPE,DADNAME,STATUS
  1. S DADTYPE=$$GET1^DIQ(8925,IEN_",",".04","I") Q:'DADTYPE Q:$$GET1^DIQ(8925.1,DADTYPE_",",".04","I")'="DC"
  1. S DADNAME=$$GET1^DIQ(8925.1,DADTYPE_",",".01")
  1. I $S(DADNAME="CLINICAL WARNING":0,DADNAME="CRISIS NOTE":0,DADNAME="ADVANCE DIRECTIVE":0,1:1) Q
  1. D POST(DFN,"patient",DFN)
  1. Q
  1. ; Deprecated calls
  1. DOCDEF ;
  1. DOCITEM ;
  1. USR ;
  1. Q
  1. ; *s68 - END
  1. PSB(PSBIEN) ; -- HMP PSB EVENTS protocol listener (BCMA) /DE2818
  1. N IEN,DFN,ORPK,TYPE,ORIFN
  1. S IEN=$S($P($G(PSBIEN),",",2)'="":+$P(PSBIEN,",",2),$G(PSBIEN)="+1":+$G(PSBIEN(1)),1:+$G(PSBIEN))
  1. S DFN=+$G(^PSB(53.79,IEN,0)),ORPK=$P($G(^(.1)),U)
  1. Q:'(DFN>0) Q:ORPK<1 S TYPE=$S(ORPK["V":"IV",ORPK["U":5,1:"") Q:TYPE="" ;DE4496 19 August 2016
  1. S ORIFN=$$ORDRNUM^PSSUTLA2(DFN,TYPE,+ORPK) ;DE4382 get order number from PSSUTLA2. ICR 6426
  1. D:ORIFN POST(DFN,"med",ORIFN)
  1. Q
  1. ;
  1. XU(IEN,ACT) ; -- XU USER ADD/CHANGE/TERMINATE option listener
  1. S IEN=+$G(IEN) Q:IEN<1
  1. D POSTX("user",IEN,$G(ACT))
  1. Q
  1. ;
  1. POST(DFN,TYPE,ID,ACT) ; -- track updated patient data
  1. S DFN=+$G(DFN),TYPE=$G(TYPE),ID=$G(ID)
  1. Q:'(DFN>0) Q:TYPE="" Q:ID="" ;incomplete request - DE4496 19 August 2016
  1. Q:$G(^XTMP("HMP-off",TYPE)) ;domain turned 'off'
  1. Q:'$D(^HMP(800000,"AITEM",DFN)) ;patient not subscribed to
  1. N HMPDT S HMPDT="HMP-"_DT
  1. ;S ^XTMP(HMPDT,$$NEXT)=DFN_U_TYPE_U_ID_U_$G(ACT)
  1. N NODES
  1. D POST^HMPDJFS(DFN,TYPE,ID,$G(ACT),"",.NODES)
  1. Q
  1. ;
  1. POSTX(TYPE,ID,ACT) ; -- track updated reference items
  1. S TYPE=$G(TYPE),ID=$G(ID)
  1. Q:TYPE="" Q:ID="" ;incomplete request
  1. Q:$G(^XTMP("HMP-off",TYPE)) ;domain turned 'off'
  1. N HMPDT S HMPDT="HMP-"_DT ;"HMPEF-"_DT
  1. ;S ^XTMP(HMPDT,$$NEXT)=U_TYPE_U_ID_U_$G(ACT)
  1. N NODES
  1. D POST^HMPDJFS("OPD",TYPE,ID,$G(ACT),"",.NODES)
  1. Q
  1. ;
  1. NEXT() ; -- Return next sequential number in ^XTMP(HMPDT,n)
  1. L +^XTMP(HMPDT):5 ;I'$T ??
  1. N Y S Y=+$O(^XTMP(HMPDT,"A"),-1)+1
  1. I '$D(^XTMP(HMPDT,0)) S ^(0)=$$FMADD^XLFDT(DT,3)_U_DT_"^HMP Updates"
  1. L -^XTMP(HMPDT)
  1. Q Y
  1. ;
  1. HTTP(URL,DFN,TYPE,ID) ; -- send message that TYPE/ID has been updated [not in use]
  1. N DIV,X,HMPX
  1. S DFN=+$G(DFN) Q:'(DFN>0) ;patient req'd - DE4496 19 August 2016
  1. S DIV=$P($$SITE^VASITE,U,3) ;station number
  1. S URL=$G(URL)_"?division="_DIV_"&dfn="_+$G(DFN)
  1. I $L($G(TYPE)) S URL=URL_"&type="_TYPE
  1. I $L($G(ID)) S URL=URL_"&id="_ID
  1. S ^XTMP("HMP",DFN,"HTTP")=$H
  1. S X=$$GETURL^XTHC10(URL,,"HMPX")
  1. ; I X>200 = ERROR
  1. Q
  1. DGREG ; register a newly registered patient in eHMP during the initial registration - Sep 29, 2015 - Phil Burkhalter
  1. Q:'($G(DFN)>0) ;DE4496 19 August 2016
  1. Q:'$D(^DPT(DFN,0)) ; Quit if patient is not in the patient file
  1. ;check the XPAR for HMP Auto Enrollment with newly registered patients,
  1. ;if set to yes for automatically adding a new HMP subscription:
  1. ;add the patient to HMP(800000 and to a pt-select update. Only want to do an update for the one patient if possible.
  1. ;if set to no for automatically adding a new HMP subscrption:
  1. ;only do the pt-select update, DO NOT add to the HMP subscription
  1. S X=$$GET^XPAR("SYS","HMP AUTOSYNC REG") ;X=1 Yes auto subscribe patient to HMP, X="" or X=0 No don't auto subscribe the patient to HMP
  1. I $G(X)'=1 D POSTX(DFN,"patient",DFN) Q ; Do pt-select
  1. I $G(X)=1 D
  1. .Q:$D(^HMP(800000,"AITEM",DFN)) ; Quit if the patient has already been added to the eHMP subscription
  1. .S ARGS("command")="putPtSubscription",ARGS("localId")=$G(DFN)
  1. .;DE3327
  1. .I '$L($G(ARGS("server"))) S ARGS("server")=$P($G(^HMP(800000,1,0)),"^") ; See comments at the top
  1. .D API^HMPDJFS(.RSLT,.ARGS) D POSTX(DFN,"patient",DFN) ; add patient to HMP(800000 and if patient is added, add patient to the freshness stream
  1. .K ARGS,RSLT
  1. K X
  1. Q