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