- PXRMCDEF ;SLC/AGP - Computed findings for Reminder Definition. ;06/30/2020
- ;;2.0;CLINICAL REMINDERS;**4,18,24,26,47,45,42**;Feb 04, 2005;Build 245
- ;
- ;======================================================
- RDEF(DFN,TEST,DATE,VALUE,TEXT) ;Computed finding for returning a Reminder
- ;definition evaluation status.
- I $G(TEST)="" D Q
- . S TEST=0
- . S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","CF.VA-REMINDER DEFINITION")="No reminder definition"
- ;New PXRMFFSS and PXRMTDEB so that reminder test function finding
- ;and term output is not corrupted.
- N DEFARR,FIEVAL,NAME,PNAME,RIEN,TEMP,PARAM,PXRMDEBG,PXRMFFSS,PXRMTDEB
- N SAVETMP,OUTTYPE
- S NAME=$P(TEST,U,1)
- I NAME="" D Q
- . S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","CF.VA-REMINDER DEFINITION")="No reminder definition."
- I +NAME=NAME S RIEN=+NAME,NAME=$P(^PXD(811.9,RIEN,0),U,1)
- E S RIEN=+$O(^PXD(811.9,"B",NAME,""))
- I RIEN=0 D Q
- . S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","CF.VA-REMINDER DEFINITION")="The reminder definition does not exist."
- I +$P(^PXD(811.9,RIEN,0),U,6)=1 D Q
- . S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","CF.VA-REMINDER DEFINITION")="The reminder definition is inactive."
- . S TEST=0
- S PARAM=$P(TEST,U,2),PARAM=$P($G(PARAM),"=",2),SAVETMP=+$P(TEST,U,3),OUTTYPE=$P(TEST,U,4)
- I OUTTYPE="" S OUTTYPE=1
- S TEST=0,DATE=$$NOW^PXRMDATE
- K ^TMP("PXRHM",$J,RIEN)
- S PNAME=$S($P($G(^PXD(811.9,RIEN,0)),U,3)'="":$P(^PXD(811.9,RIEN,0),U,3),1:NAME)
- ;Load the definition into DEFARR.
- D DEF^PXRMLDR(RIEN,.DEFARR)
- D EVAL^PXRM(DFN,.DEFARR,OUTTYPE,0,.FIEVAL,DATE)
- S TEMP=$G(^TMP("PXRHM",$J,RIEN,PNAME))
- I SAVETMP,$G(PXRMSRCFF) D
- . K ^TMP("PXRM BL DATA",$J)
- . M ^TMP("PXRM BL DATA",$J,"FIEVAL")=FIEVAL
- . M ^TMP("PXRM BL DATA",$J,"PXRHM")=^TMP("PXRHM",$J)
- . S ^TMP("PXRM BL DATA",$J,"REMINDER IEN")=RIEN
- . S ^TMP("PXRM BL DATA",$J,"REMINDER NAME")=PNAME
- K ^TMP("PXRHM",$J,RIEN)
- S TEST=$S(TEMP="":0,TEMP["ERROR":0,TEMP["CNBD":0,1:1)
- Q:'TEST
- S TEXT="Reminder: "_NAME
- S VALUE=$P(TEMP,U)
- S VALUE("STATUS")=VALUE
- S VALUE("DUEDATE")=$P(TEMP,U,2)
- S VALUE("LASTDONE")=$P(TEMP,U,3)
- Q:PARAM=""
- I PARAM="DUE DATE",+VALUE("DUEDATE")>0 S DATE=VALUE("DUEDATE")
- I PARAM="LAST DONE",+VALUE("LASTDONE")>0 S DATE=VALUE("LASTDONE")
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMCDEF 2233 printed Mar 13, 2025@20:47:47 Page 2
- PXRMCDEF ;SLC/AGP - Computed findings for Reminder Definition. ;06/30/2020
- +1 ;;2.0;CLINICAL REMINDERS;**4,18,24,26,47,45,42**;Feb 04, 2005;Build 245
- +2 ;
- +3 ;======================================================
- RDEF(DFN,TEST,DATE,VALUE,TEXT) ;Computed finding for returning a Reminder
- +1 ;definition evaluation status.
- +2 IF $GET(TEST)=""
- Begin DoDot:1
- +3 SET TEST=0
- +4 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","CF.VA-REMINDER DEFINITION")="No reminder definition"
- End DoDot:1
- QUIT
- +5 ;New PXRMFFSS and PXRMTDEB so that reminder test function finding
- +6 ;and term output is not corrupted.
- +7 NEW DEFARR,FIEVAL,NAME,PNAME,RIEN,TEMP,PARAM,PXRMDEBG,PXRMFFSS,PXRMTDEB
- +8 NEW SAVETMP,OUTTYPE
- +9 SET NAME=$PIECE(TEST,U,1)
- +10 IF NAME=""
- Begin DoDot:1
- +11 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","CF.VA-REMINDER DEFINITION")="No reminder definition."
- End DoDot:1
- QUIT
- +12 IF +NAME=NAME
- SET RIEN=+NAME
- SET NAME=$PIECE(^PXD(811.9,RIEN,0),U,1)
- +13 IF '$TEST
- SET RIEN=+$ORDER(^PXD(811.9,"B",NAME,""))
- +14 IF RIEN=0
- Begin DoDot:1
- +15 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","CF.VA-REMINDER DEFINITION")="The reminder definition does not exist."
- End DoDot:1
- QUIT
- +16 IF +$PIECE(^PXD(811.9,RIEN,0),U,6)=1
- Begin DoDot:1
- +17 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","CF.VA-REMINDER DEFINITION")="The reminder definition is inactive."
- +18 SET TEST=0
- End DoDot:1
- QUIT
- +19 SET PARAM=$PIECE(TEST,U,2)
- SET PARAM=$PIECE($GET(PARAM),"=",2)
- SET SAVETMP=+$PIECE(TEST,U,3)
- SET OUTTYPE=$PIECE(TEST,U,4)
- +20 IF OUTTYPE=""
- SET OUTTYPE=1
- +21 SET TEST=0
- SET DATE=$$NOW^PXRMDATE
- +22 KILL ^TMP("PXRHM",$JOB,RIEN)
- +23 SET PNAME=$SELECT($PIECE($GET(^PXD(811.9,RIEN,0)),U,3)'="":$PIECE(^PXD(811.9,RIEN,0),U,3),1:NAME)
- +24 ;Load the definition into DEFARR.
- +25 DO DEF^PXRMLDR(RIEN,.DEFARR)
- +26 DO EVAL^PXRM(DFN,.DEFARR,OUTTYPE,0,.FIEVAL,DATE)
- +27 SET TEMP=$GET(^TMP("PXRHM",$JOB,RIEN,PNAME))
- +28 IF SAVETMP
- IF $GET(PXRMSRCFF)
- Begin DoDot:1
- +29 KILL ^TMP("PXRM BL DATA",$JOB)
- +30 MERGE ^TMP("PXRM BL DATA",$JOB,"FIEVAL")=FIEVAL
- +31 MERGE ^TMP("PXRM BL DATA",$JOB,"PXRHM")=^TMP("PXRHM",$JOB)
- +32 SET ^TMP("PXRM BL DATA",$JOB,"REMINDER IEN")=RIEN
- +33 SET ^TMP("PXRM BL DATA",$JOB,"REMINDER NAME")=PNAME
- End DoDot:1
- +34 KILL ^TMP("PXRHM",$JOB,RIEN)
- +35 SET TEST=$SELECT(TEMP="":0,TEMP["ERROR":0,TEMP["CNBD":0,1:1)
- +36 if 'TEST
- QUIT
- +37 SET TEXT="Reminder: "_NAME
- +38 SET VALUE=$PIECE(TEMP,U)
- +39 SET VALUE("STATUS")=VALUE
- +40 SET VALUE("DUEDATE")=$PIECE(TEMP,U,2)
- +41 SET VALUE("LASTDONE")=$PIECE(TEMP,U,3)
- +42 if PARAM=""
- QUIT
- +43 IF PARAM="DUE DATE"
- IF +VALUE("DUEDATE")>0
- SET DATE=VALUE("DUEDATE")
- +44 IF PARAM="LAST DONE"
- IF +VALUE("LASTDONE")>0
- SET DATE=VALUE("LASTDONE")
- +45 QUIT
- +46 ;
