- 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 Feb 18, 2025@23:20:55 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 ;