HMPAT ;ASMR/EJK,ASF,CK - ASU/TIU Trigger to HMP Activity File;May 15, 2016 14:15
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1**;May 15, 2016;Build 4
;Per VA Directive 6402, this routine should not be modified.
;
; DE2818 - SQA findings. Newed HMPRSLT in ECLASS+10. RRB - 10/27/2015
Q
ECLASS(HMPIEN) ; called from EDIT^USRCLASS,ADD^USRRULA
N HMPSYS,TYPE,HMPMAX,HMPI,HMPID,HMPERR,HMPRSLT,HMPTN,HMPLAST,HMPCNT,HMPFINI,HMPFRSP,HMPARGS
N $ES,$ET,ERRMSG
S HMPID=$P($G(USRDATA),U,2)
S HMP=$NA(^TMP("HMP",$J)),HMPI=0 K @HMP
S HMPSYS=$$SYS^HMPUTILS
S (HMPMAX,HMPLAST,HMPID)="",HMPCNT=0
S HMPARGS("server")=$O(^HMP(800000,"B",""))
S HMPARGS("command")="startOperationalDataExtract"
S HMPARGS("domains")="asu-class"
D API^HMPDJFS(.HMPRSLT,.HMPARGS)
Q
;
ERULE ; called from EDIT1^USRRULA
N HMPSYS,TYPE,HMPMAX,HMPI,HMPID,HMPERR,HMPTN,HMPLAST,HMPCNT,HMPFINI,HMPFRSP,HMPARGS
N $ES,$ET,ERRMSG
S HMP=$NA(^TMP("HMP",$J)),HMPI=0 K @HMP
S HMPSYS=$$SYS^HMPUTILS
S (HMPMAX,HMPLAST,HMPID)="",HMPCNT=0
S HMPARGS("server")=$O(^HMP(800000,"B",""))
S HMPARGS("command")="startOperationalDataExtract"
S HMPARGS("domains")="asu-rule"
D API^HMPDJFS(.HMPRSLT,.HMPARGS)
Q
;
EDEF ; called from option TIU DOCUMENT DEFINITION EDIT
N HMPDA
S HMPDA=$P(XQLOK,",",2),HMPDA=$TR(HMPDA,")","")
; DE2818 begin change ASF 11/9/15
;I HMPDA?1N.N,$D(^TIU(8925.1,HMPDA)) D POSTX^HMPEVNT("doc-def",HMPDA)
;I HMPDA?1N.N,'$D(^TIU(8925.1,HMPDA)) D POSTX^HMPEVNT("doc-def",HMPDA,"@")
N DA,DIC,DIQ,DR,R ; FileMan variables
S DIC=8925.1,DR=.01,DA=HMPDA,DIQ="R" D EN^DIQ1
D:$D(R(8925.1,DA,.01)) POSTX^HMPEVNT("doc-def",HMPDA)
D:'$D(R(8925.1,DA,.01)) POSTX^HMPEVNT("doc-def",HMPDA,"@")
; DE2818 end change
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPAT 1739 printed Oct 16, 2024@17:53:41 Page 2
HMPAT ;ASMR/EJK,ASF,CK - ASU/TIU Trigger to HMP Activity File;May 15, 2016 14:15
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1**;May 15, 2016;Build 4
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; DE2818 - SQA findings. Newed HMPRSLT in ECLASS+10. RRB - 10/27/2015
+5 QUIT
ECLASS(HMPIEN) ; called from EDIT^USRCLASS,ADD^USRRULA
+1 NEW HMPSYS,TYPE,HMPMAX,HMPI,HMPID,HMPERR,HMPRSLT,HMPTN,HMPLAST,HMPCNT,HMPFINI,HMPFRSP,HMPARGS
+2 NEW $ESTACK,$ETRAP,ERRMSG
+3 SET HMPID=$PIECE($GET(USRDATA),U,2)
+4 SET HMP=$NAME(^TMP("HMP",$JOB))
SET HMPI=0
KILL @HMP
+5 SET HMPSYS=$$SYS^HMPUTILS
+6 SET (HMPMAX,HMPLAST,HMPID)=""
SET HMPCNT=0
+7 SET HMPARGS("server")=$ORDER(^HMP(800000,"B",""))
+8 SET HMPARGS("command")="startOperationalDataExtract"
+9 SET HMPARGS("domains")="asu-class"
+10 DO API^HMPDJFS(.HMPRSLT,.HMPARGS)
+11 QUIT
+12 ;
ERULE ; called from EDIT1^USRRULA
+1 NEW HMPSYS,TYPE,HMPMAX,HMPI,HMPID,HMPERR,HMPTN,HMPLAST,HMPCNT,HMPFINI,HMPFRSP,HMPARGS
+2 NEW $ESTACK,$ETRAP,ERRMSG
+3 SET HMP=$NAME(^TMP("HMP",$JOB))
SET HMPI=0
KILL @HMP
+4 SET HMPSYS=$$SYS^HMPUTILS
+5 SET (HMPMAX,HMPLAST,HMPID)=""
SET HMPCNT=0
+6 SET HMPARGS("server")=$ORDER(^HMP(800000,"B",""))
+7 SET HMPARGS("command")="startOperationalDataExtract"
+8 SET HMPARGS("domains")="asu-rule"
+9 DO API^HMPDJFS(.HMPRSLT,.HMPARGS)
+10 QUIT
+11 ;
EDEF ; called from option TIU DOCUMENT DEFINITION EDIT
+1 NEW HMPDA
+2 SET HMPDA=$PIECE(XQLOK,",",2)
SET HMPDA=$TRANSLATE(HMPDA,")","")
+3 ; DE2818 begin change ASF 11/9/15
+4 ;I HMPDA?1N.N,$D(^TIU(8925.1,HMPDA)) D POSTX^HMPEVNT("doc-def",HMPDA)
+5 ;I HMPDA?1N.N,'$D(^TIU(8925.1,HMPDA)) D POSTX^HMPEVNT("doc-def",HMPDA,"@")
+6 ; FileMan variables
NEW DA,DIC,DIQ,DR,R
+7 SET DIC=8925.1
SET DR=.01
SET DA=HMPDA
SET DIQ="R"
DO EN^DIQ1
+8 if $DATA(R(8925.1,DA,.01))
DO POSTX^HMPEVNT("doc-def",HMPDA)
+9 if '$DATA(R(8925.1,DA,.01))
DO POSTX^HMPEVNT("doc-def",HMPDA,"@")
+10 ; DE2818 end change
+11 QUIT
