HMPPXRM ;SLC/AGP,ASMR/RRB,CK - Clinical Reminders routine;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.
;
Q
;
EVALLIST(RESULT,PT,USER,LOC) ;
N CNT,NUM,RIEN,TMP,UID,HMPTMP,HMPSYS
N DUEDATE,I,J,LASTDONE,NAME,NODE,STATUS,TXT
;S USER=$P(USERUID,":",5)
D GETLIST^ORQQPX(.HMPTMP,LOC)
S HMPSYS=$$SYS^HMPUTILS
S CNT=0,NUM=0 F S CNT=$O(HMPTMP(CNT)) Q:CNT'>0 D
.S RIEN=$G(HMPTMP(CNT)) I RIEN'>0 Q
.;begin fix DE 2818 ICR 6113 ASF 11/16
.;S NAME="" S NAME=$P($G(^PXD(811.9,RIEN,0)),U,3)
.;I NAME="" S NAME=$P($G(^PXD(811.9,RIEN,0)),U)
.S NAME=$$GET1^DIQ(811.9,REIN_",",1.2)
.I NAME="" S NAME=$$GET1^DIQ(811.9,REIN_",",.01)
.; end DE2818 fix
.S UID="urn:va:pxrm:"_HMPSYS_":"_RIEN
.S NUM=NUM+1,TMP("reminders",NUM,"uid")=UID,TMP("reminders",NUM,"name")=NAME
.K ^TMP("PXRHM",$J)
.D MAIN^PXRM(PT,RIEN,5) ; 5 returns all reminder info
.S I=1,TXT=""
.S NAME="",NAME=$O(^TMP("PXRHM",$J,RIEN,NAME)) Q:NAME="" D
..S NODE=$G(^TMP("PXRHM",$J,RIEN,NAME))
..S STATUS=$P(NODE,U),DUEDATE=$$JSONDT^HMPUTILS($P(NODE,U,2)),LASTDONE=$$JSONDT^HMPUTILS($P(NODE,U,3))
..S J=0 F S J=$O(^TMP("PXRHM",$J,RIEN,NAME,"TXT",J)) Q:J="" D
...S TXT=$G(TXT)_^TMP("PXRHM",$J,RIEN,NAME,"TXT",J)_$C(13)_$C(10),I=I+1
.K ^TMP("PXRHM",$J)
.S TMP("reminders",NUM,"status")=STATUS
.S TMP("reminders",NUM,"dueDate")=DUEDATE
.S TMP("reminders",NUM,"lastDone")=LASTDONE
.S TMP("reminders",NUM,"clinicalMaintenance")=TXT
S TMP("success")="true"
D ENCODE^HMPJSON("TMP","RESULT","ERROR")
I $D(ERROR) D SETERROR(.TMP,.ERROR,.RESULT)
Q
;
EVALREM(RESULT,PT,UID) ;return detail for a pt's clinical reminder
K ^TMP("PXRHM",$J)
N DUEDATE,I,J,LASTDONE,NAME,NODE,RIEN,STATUS,TMP,TXT
S RIEN=$P(UID,":",5)
D MAIN^PXRM(PT,RIEN,5) ; 5 returns all reminder info
S I=1,TXT=""
S NAME="",NAME=$O(^TMP("PXRHM",$J,RIEN,NAME)) Q:NAME="" D
.S NODE=$G(^TMP("PXRHM",$J,RIEN,NAME))
.S STATUS=$P(NODE,U),DUEDATE=$$JSONDT^HMPUTILS($P(NODE,U,2)),LASTDONE=$$JSONDT^HMPUTILS($P(NODE,U,3))
.S J=0 F S J=$O(^TMP("PXRHM",$J,RIEN,NAME,"TXT",J)) Q:J="" D
..S TXT=$G(TXT)_^TMP("PXRHM",$J,RIEN,NAME,"TXT",J)_$C(13)_$C(10),I=I+1
K ^TMP("PXRHM",$J)
S TMP("uid")=UID
S TMP("status")=STATUS
S TMP("dueDate")=DUEDATE
S TMP("lastDone")=LASTDONE
S TMP("clinicalMaintenance")=TXT
S TMP("success")="true"
D ENCODE^HMPJSON("TMP","RESULT","ERROR")
I $D(ERROR) D SETERROR(.TMP,.ERROR,.RESULT)
Q
;
REMLIST(RESULT,USERUID,LOC) ;
N CNT,NUM,RIEN,TMP,UID,USER,HMPTMP,HMPSYS
S USER=$P(USERUID,":",5)
D GETLIST^ORQQPX(.HMPTMP,LOC)
S HMPSYS=$$SYS^HMPUTILS
S CNT=0,NUM=0 F S CNT=$O(HMPTMP(CNT)) Q:CNT'>0 D
.S RIEN=$G(HMPTMP(CNT)) I RIEN'>0 Q
.;begin fix DE 2818 ICR 6113 ASF 11/16
.;S NAME="" S NAME=$P($G(^PXD(811.9,RIEN,0)),U,3)
.;I NAME="" S NAME=$P($G(^PXD(811.9,RIEN,0)),U)
.S NAME=$$GET1^DIQ(811.9,REIN_",",1.2)
.I NAME="" S NAME=$$GET1^DIQ(811.9,REIN_",",.01)
.; end DE2818 fix
.S UID="urn:va:pxrm:"_HMPSYS_":"_RIEN
.S NUM=NUM+1,TMP("reminders",NUM,"uid")=UID,TMP("reminders",NUM,"name")=NAME
S TMP("success")="true"
D ENCODE^HMPJSON("TMP","RESULT","ERROR")
I $D(ERROR) D SETERROR(.TMP,.ERROR,.RESULT)
Q
;
SETERROR(INPDATA,ERRORMSG,OUTPUT) ;
N ERRARR,TXT
S TXT(1)="Problem encoding json output"
D SETERROR^HMPUTILS(.ERRARR,.ERRORMSG,.TXT,.INPDATA)
D ENCODE^HMPJSON("ERRARR","OUTPUT","ERROR")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPPXRM 3485 printed Oct 16, 2024@17:55:14 Page 2
HMPPXRM ;SLC/AGP,ASMR/RRB,CK - Clinical Reminders routine;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 QUIT
+5 ;
EVALLIST(RESULT,PT,USER,LOC) ;
+1 NEW CNT,NUM,RIEN,TMP,UID,HMPTMP,HMPSYS
+2 NEW DUEDATE,I,J,LASTDONE,NAME,NODE,STATUS,TXT
+3 ;S USER=$P(USERUID,":",5)
+4 DO GETLIST^ORQQPX(.HMPTMP,LOC)
+5 SET HMPSYS=$$SYS^HMPUTILS
+6 SET CNT=0
SET NUM=0
FOR
SET CNT=$ORDER(HMPTMP(CNT))
if CNT'>0
QUIT
Begin DoDot:1
+7 SET RIEN=$GET(HMPTMP(CNT))
IF RIEN'>0
QUIT
+8 ;begin fix DE 2818 ICR 6113 ASF 11/16
+9 ;S NAME="" S NAME=$P($G(^PXD(811.9,RIEN,0)),U,3)
+10 ;I NAME="" S NAME=$P($G(^PXD(811.9,RIEN,0)),U)
+11 SET NAME=$$GET1^DIQ(811.9,REIN_",",1.2)
+12 IF NAME=""
SET NAME=$$GET1^DIQ(811.9,REIN_",",.01)
+13 ; end DE2818 fix
+14 SET UID="urn:va:pxrm:"_HMPSYS_":"_RIEN
+15 SET NUM=NUM+1
SET TMP("reminders",NUM,"uid")=UID
SET TMP("reminders",NUM,"name")=NAME
+16 KILL ^TMP("PXRHM",$JOB)
+17 ; 5 returns all reminder info
DO MAIN^PXRM(PT,RIEN,5)
+18 SET I=1
SET TXT=""
+19 SET NAME=""
SET NAME=$ORDER(^TMP("PXRHM",$JOB,RIEN,NAME))
if NAME=""
QUIT
Begin DoDot:2
+20 SET NODE=$GET(^TMP("PXRHM",$JOB,RIEN,NAME))
+21 SET STATUS=$PIECE(NODE,U)
SET DUEDATE=$$JSONDT^HMPUTILS($PIECE(NODE,U,2))
SET LASTDONE=$$JSONDT^HMPUTILS($PIECE(NODE,U,3))
+22 SET J=0
FOR
SET J=$ORDER(^TMP("PXRHM",$JOB,RIEN,NAME,"TXT",J))
if J=""
QUIT
Begin DoDot:3
+23 SET TXT=$GET(TXT)_^TMP("PXRHM",$JOB,RIEN,NAME,"TXT",J)_$CHAR(13)_$CHAR(10)
SET I=I+1
End DoDot:3
End DoDot:2
+24 KILL ^TMP("PXRHM",$JOB)
+25 SET TMP("reminders",NUM,"status")=STATUS
+26 SET TMP("reminders",NUM,"dueDate")=DUEDATE
+27 SET TMP("reminders",NUM,"lastDone")=LASTDONE
+28 SET TMP("reminders",NUM,"clinicalMaintenance")=TXT
End DoDot:1
+29 SET TMP("success")="true"
+30 DO ENCODE^HMPJSON("TMP","RESULT","ERROR")
+31 IF $DATA(ERROR)
DO SETERROR(.TMP,.ERROR,.RESULT)
+32 QUIT
+33 ;
EVALREM(RESULT,PT,UID) ;return detail for a pt's clinical reminder
+1 KILL ^TMP("PXRHM",$JOB)
+2 NEW DUEDATE,I,J,LASTDONE,NAME,NODE,RIEN,STATUS,TMP,TXT
+3 SET RIEN=$PIECE(UID,":",5)
+4 ; 5 returns all reminder info
DO MAIN^PXRM(PT,RIEN,5)
+5 SET I=1
SET TXT=""
+6 SET NAME=""
SET NAME=$ORDER(^TMP("PXRHM",$JOB,RIEN,NAME))
if NAME=""
QUIT
Begin DoDot:1
+7 SET NODE=$GET(^TMP("PXRHM",$JOB,RIEN,NAME))
+8 SET STATUS=$PIECE(NODE,U)
SET DUEDATE=$$JSONDT^HMPUTILS($PIECE(NODE,U,2))
SET LASTDONE=$$JSONDT^HMPUTILS($PIECE(NODE,U,3))
+9 SET J=0
FOR
SET J=$ORDER(^TMP("PXRHM",$JOB,RIEN,NAME,"TXT",J))
if J=""
QUIT
Begin DoDot:2
+10 SET TXT=$GET(TXT)_^TMP("PXRHM",$JOB,RIEN,NAME,"TXT",J)_$CHAR(13)_$CHAR(10)
SET I=I+1
End DoDot:2
End DoDot:1
+11 KILL ^TMP("PXRHM",$JOB)
+12 SET TMP("uid")=UID
+13 SET TMP("status")=STATUS
+14 SET TMP("dueDate")=DUEDATE
+15 SET TMP("lastDone")=LASTDONE
+16 SET TMP("clinicalMaintenance")=TXT
+17 SET TMP("success")="true"
+18 DO ENCODE^HMPJSON("TMP","RESULT","ERROR")
+19 IF $DATA(ERROR)
DO SETERROR(.TMP,.ERROR,.RESULT)
+20 QUIT
+21 ;
REMLIST(RESULT,USERUID,LOC) ;
+1 NEW CNT,NUM,RIEN,TMP,UID,USER,HMPTMP,HMPSYS
+2 SET USER=$PIECE(USERUID,":",5)
+3 DO GETLIST^ORQQPX(.HMPTMP,LOC)
+4 SET HMPSYS=$$SYS^HMPUTILS
+5 SET CNT=0
SET NUM=0
FOR
SET CNT=$ORDER(HMPTMP(CNT))
if CNT'>0
QUIT
Begin DoDot:1
+6 SET RIEN=$GET(HMPTMP(CNT))
IF RIEN'>0
QUIT
+7 ;begin fix DE 2818 ICR 6113 ASF 11/16
+8 ;S NAME="" S NAME=$P($G(^PXD(811.9,RIEN,0)),U,3)
+9 ;I NAME="" S NAME=$P($G(^PXD(811.9,RIEN,0)),U)
+10 SET NAME=$$GET1^DIQ(811.9,REIN_",",1.2)
+11 IF NAME=""
SET NAME=$$GET1^DIQ(811.9,REIN_",",.01)
+12 ; end DE2818 fix
+13 SET UID="urn:va:pxrm:"_HMPSYS_":"_RIEN
+14 SET NUM=NUM+1
SET TMP("reminders",NUM,"uid")=UID
SET TMP("reminders",NUM,"name")=NAME
End DoDot:1
+15 SET TMP("success")="true"
+16 DO ENCODE^HMPJSON("TMP","RESULT","ERROR")
+17 IF $DATA(ERROR)
DO SETERROR(.TMP,.ERROR,.RESULT)
+18 QUIT
+19 ;
SETERROR(INPDATA,ERRORMSG,OUTPUT) ;
+1 NEW ERRARR,TXT
+2 SET TXT(1)="Problem encoding json output"
+3 DO SETERROR^HMPUTILS(.ERRARR,.ERRORMSG,.TXT,.INPDATA)
+4 DO ENCODE^HMPJSON("ERRARR","OUTPUT","ERROR")
+5 QUIT
+6 ;
