HMPAT.m

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 ---HMPAT   1739     printed  Apr 09, 2024@20:59:03                                                                                                                                                                                                       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