PXRMDLNK ;SLC/AGP - Dialog Link Functions ;Jan 12, 2023@19:16
;;2.0;CLINICAL REMINDERS;**45,84**;Feb 04, 2005;Build 2
;
SUBCHK(IEN,VALUE) ;INPUT TRANSFORMS For file 801.48
N FUNC
S FUNC=$P($G(^PXRMD(801.48,IEN,0)),U,4) I FUNC'>0 Q 0
I '$D(^PXRMD(801.48,IEN,"B",VALUE)) Q 0
Q 1
;
FINDCHK(DA,VALUE) ;
N CNT,FAIL,FUNC,NODE,NUM,PAT,PATTENS,PATTEN,SUB
S FUNC=$P($G(^PXRMD(801.48,DA(1),0)),U,4) I FUNC'>0 Q 0
S CNT=0 F S CNT=$O(^PXRMD(801.47,FUNC,2,CNT)) Q:CNT'>0 D
.S NODE=$G(^PXRMD(801.47,FUNC,2,CNT,0))
.S SUB=$P(NODE,U),PATTEN=$P(NODE,U,2)
.Q:SUB="" Q:PATTEN=""
.S PATTENS(SUB)=PATTEN
I '$D(PATTENS) Q 0
;
S SUB=$P($G(^PXRMD(801.48,DA(1),2,DA,0)),U)
I SUB="" Q 0
S FAIL=1,PATTEN=$G(PATTENS(SUB))
I PATTEN="" Q 1
S NUM=$L(PATTEN,"~")
F CNT=1:1:NUM D I FAIL=0 Q
.S PAT=$P(PATTEN,"~",CNT)
.I VALUE?@PAT S FAIL=0
I FAIL=1 Q 0
Q 1
;
DATEDIFF(RESULT,PAT,NVALUE,OVALUE,INPUTS) ;FUNCTIONS FROM FILE 801.47
I $G(INPUTS("OLD DATE IS SPECIFC"))=1,OVALUE=-1 S RESULT=1 Q 1
I $G(INPUTS("OLD DATE IS SPECIFC"))=1,$$ISFULDTE^PXRMDATE(OVALUE)=0 Q 0
I $G(INPUTS("NEW DATE IS SPECIFC"))=1,$$ISFULDTE^PXRMDATE(NVALUE)=0 Q 0
S RESULT=$$FMDIFF^XLFDT(NVALUE,OVALUE,1)
I RESULT=0 Q 0
Q 1
;
DATEOFF(RESULT,PAT,NVALUE,OVALUE,INPUTS) ;
I $G(INPUTS("STARTING DATE"))=1,$$ISFULDTE^PXRMDATE(NVALUE)=0 Q 0
S RESULT=$$FMADD^XLFDT(NVALUE,$G(INPUTS("OFFSET")))
Q 1
;
DATEHIST(RESULT,PAT,NVALUE,OVALUE,INPUTS) ;
I $G(INPUTS("NEW DATE IS SPECIFC"))=2,$$ISFULDTE^PXRMDATE(NVALUE)=0 Q 0
I $G(INPUTS("USE TODAY DATE"))=1 D Q 1
.;S OVALUE=DT
.S RESULT=$$FMDIFF^XLFDT(NVALUE,DT,1) I RESULT<0 S RESULT=NVALUE Q
.S RESULT=""
S RESULT=NVALUE
Q 1
;
REMEVAL(RESULT,PAT,NVALUE,OVALUE,INPUTS) ;
I '$D(INPUTS("DEFINITION")) Q 0
I '$D(INPUTS("STATUS")) Q 0
N NAME,NODE,RIEN,RNAME,RSTAT,STATUS
S RESULT=0
S NAME=INPUTS("DEFINITION")
S RSTAT=INPUTS("STATUS")
S RIEN=$O(^PXD(811.9,"B",NAME,"")) I RIEN'>0 Q 0
S NODE=$G(^PXD(811.9,RIEN,0))
S RNAME=$S($P(NODE,U,3)'="":$P(NODE,U,3),1:$P(NODE,U))
K ^TMP("PXRHM",$J)
D MAIN^PXRM(PAT,RIEN,55,1)
S STATUS=$P($G(^TMP("PXRHM",$J,RIEN,RNAME)),U)
K ^TMP("PXRHM",$J)
S RESULT=$$STATMTCH^PXRMORCH(STATUS,RSTAT)
Q 1
;
TERMEVAL(RESULT,PAT,NVALUE,OVALUE,INPUTS) ;
I '$D(INPUTS("TERM")) Q 0
I '$D(INPUTS("STATUS")) Q 0
N FIEVAL,NAME,NODE,TIEN,TSTAT,STATUS
S RESULT=0
S NAME=INPUTS("TERM")
S TSTAT=INPUTS("STATUS")
S TIEN=$O(^PXRMD(811.5,"B",NAME,"")) I TIEN'>0 Q 0
S STATUS=$$TERM^PXRMDLLB(TIEN,PAT,TIEN,"O",.FIEVAL)
S RESULT=$S(TSTAT=STATUS:1,1:0)
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDLNK 2594 printed Apr 09, 2024@20:48:48 Page 2
PXRMDLNK ;SLC/AGP - Dialog Link Functions ;Jan 12, 2023@19:16
+1 ;;2.0;CLINICAL REMINDERS;**45,84**;Feb 04, 2005;Build 2
+2 ;
SUBCHK(IEN,VALUE) ;INPUT TRANSFORMS For file 801.48
+1 NEW FUNC
+2 SET FUNC=$PIECE($GET(^PXRMD(801.48,IEN,0)),U,4)
IF FUNC'>0
QUIT 0
+3 IF '$DATA(^PXRMD(801.48,IEN,"B",VALUE))
QUIT 0
+4 QUIT 1
+5 ;
FINDCHK(DA,VALUE) ;
+1 NEW CNT,FAIL,FUNC,NODE,NUM,PAT,PATTENS,PATTEN,SUB
+2 SET FUNC=$PIECE($GET(^PXRMD(801.48,DA(1),0)),U,4)
IF FUNC'>0
QUIT 0
+3 SET CNT=0
FOR
SET CNT=$ORDER(^PXRMD(801.47,FUNC,2,CNT))
if CNT'>0
QUIT
Begin DoDot:1
+4 SET NODE=$GET(^PXRMD(801.47,FUNC,2,CNT,0))
+5 SET SUB=$PIECE(NODE,U)
SET PATTEN=$PIECE(NODE,U,2)
+6 if SUB=""
QUIT
if PATTEN=""
QUIT
+7 SET PATTENS(SUB)=PATTEN
End DoDot:1
+8 IF '$DATA(PATTENS)
QUIT 0
+9 ;
+10 SET SUB=$PIECE($GET(^PXRMD(801.48,DA(1),2,DA,0)),U)
+11 IF SUB=""
QUIT 0
+12 SET FAIL=1
SET PATTEN=$GET(PATTENS(SUB))
+13 IF PATTEN=""
QUIT 1
+14 SET NUM=$LENGTH(PATTEN,"~")
+15 FOR CNT=1:1:NUM
Begin DoDot:1
+16 SET PAT=$PIECE(PATTEN,"~",CNT)
+17 IF VALUE?@PAT
SET FAIL=0
End DoDot:1
IF FAIL=0
QUIT
+18 IF FAIL=1
QUIT 0
+19 QUIT 1
+20 ;
DATEDIFF(RESULT,PAT,NVALUE,OVALUE,INPUTS) ;FUNCTIONS FROM FILE 801.47
+1 IF $GET(INPUTS("OLD DATE IS SPECIFC"))=1
IF OVALUE=-1
SET RESULT=1
QUIT 1
+2 IF $GET(INPUTS("OLD DATE IS SPECIFC"))=1
IF $$ISFULDTE^PXRMDATE(OVALUE)=0
QUIT 0
+3 IF $GET(INPUTS("NEW DATE IS SPECIFC"))=1
IF $$ISFULDTE^PXRMDATE(NVALUE)=0
QUIT 0
+4 SET RESULT=$$FMDIFF^XLFDT(NVALUE,OVALUE,1)
+5 IF RESULT=0
QUIT 0
+6 QUIT 1
+7 ;
DATEOFF(RESULT,PAT,NVALUE,OVALUE,INPUTS) ;
+1 IF $GET(INPUTS("STARTING DATE"))=1
IF $$ISFULDTE^PXRMDATE(NVALUE)=0
QUIT 0
+2 SET RESULT=$$FMADD^XLFDT(NVALUE,$GET(INPUTS("OFFSET")))
+3 QUIT 1
+4 ;
DATEHIST(RESULT,PAT,NVALUE,OVALUE,INPUTS) ;
+1 IF $GET(INPUTS("NEW DATE IS SPECIFC"))=2
IF $$ISFULDTE^PXRMDATE(NVALUE)=0
QUIT 0
+2 IF $GET(INPUTS("USE TODAY DATE"))=1
Begin DoDot:1
+3 ;S OVALUE=DT
+4 SET RESULT=$$FMDIFF^XLFDT(NVALUE,DT,1)
IF RESULT<0
SET RESULT=NVALUE
QUIT
+5 SET RESULT=""
End DoDot:1
QUIT 1
+6 SET RESULT=NVALUE
+7 QUIT 1
+8 ;
REMEVAL(RESULT,PAT,NVALUE,OVALUE,INPUTS) ;
+1 IF '$DATA(INPUTS("DEFINITION"))
QUIT 0
+2 IF '$DATA(INPUTS("STATUS"))
QUIT 0
+3 NEW NAME,NODE,RIEN,RNAME,RSTAT,STATUS
+4 SET RESULT=0
+5 SET NAME=INPUTS("DEFINITION")
+6 SET RSTAT=INPUTS("STATUS")
+7 SET RIEN=$ORDER(^PXD(811.9,"B",NAME,""))
IF RIEN'>0
QUIT 0
+8 SET NODE=$GET(^PXD(811.9,RIEN,0))
+9 SET RNAME=$SELECT($PIECE(NODE,U,3)'="":$PIECE(NODE,U,3),1:$PIECE(NODE,U))
+10 KILL ^TMP("PXRHM",$JOB)
+11 DO MAIN^PXRM(PAT,RIEN,55,1)
+12 SET STATUS=$PIECE($GET(^TMP("PXRHM",$JOB,RIEN,RNAME)),U)
+13 KILL ^TMP("PXRHM",$JOB)
+14 SET RESULT=$$STATMTCH^PXRMORCH(STATUS,RSTAT)
+15 QUIT 1
+16 ;
TERMEVAL(RESULT,PAT,NVALUE,OVALUE,INPUTS) ;
+1 IF '$DATA(INPUTS("TERM"))
QUIT 0
+2 IF '$DATA(INPUTS("STATUS"))
QUIT 0
+3 NEW FIEVAL,NAME,NODE,TIEN,TSTAT,STATUS
+4 SET RESULT=0
+5 SET NAME=INPUTS("TERM")
+6 SET TSTAT=INPUTS("STATUS")
+7 SET TIEN=$ORDER(^PXRMD(811.5,"B",NAME,""))
IF TIEN'>0
QUIT 0
+8 SET STATUS=$$TERM^PXRMDLLB(TIEN,PAT,TIEN,"O",.FIEVAL)
+9 SET RESULT=$SELECT(TSTAT=STATUS:1,1:0)
+10 QUIT 1
+11 ;
