- 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 Feb 18, 2025@23:19:21 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
