PXRMTUTL ;SLC/AGP - Reminder term utility routine. ;04/06/2020
;;2.0;CLINICAL REMINDERS;**72**;Feb 04, 2005;Build 16
;
;=================================
SETTFIND(RESULT,TNAME,FINDING) ;
N FCNT,FDA,FIELD,ICNT,IENS,MSG,SCNT,SIDX,TIEN,VALUE
S TIEN=$O(^PXRMD(811.5,"B",TNAME,""))
I TIEN=0 S RESULT="-1^Reminder term "_TNAME_" not found in Reminder Term file" Q
S FDA(811.5,TIEN_",",.01)=TNAME
S FCNT=TIEN,SCNT=0
S ICNT=0 F S ICNT=$O(FINDING(ICNT)) Q:ICNT'>0 D
.S FIELD="" F S FIELD=$O(FINDING(ICNT,FIELD)) Q:FIELD="" D
..I FIELD=.01 D
...I SCNT>0,SCNT>0 S FCNT=SCNT+1 Q
...S FCNT=FCNT+1
..I FIELD'="STATUS" D Q
...S VALUE=FINDING(ICNT,FIELD) I VALUE="" Q
...S FDA(811.52,"+"_FCNT_","_TIEN_",",FIELD)=VALUE
..I FIELD="STATUS" D
...S SCNT=FCNT
...S SIDX=0 F S SIDX=$O(FINDING(ICNT,FIELD,SIDX)) Q:SIDX'>0 D
....S VALUE=FINDING(ICNT,FIELD,SIDX) Q:VALUE=""
....S SCNT=SCNT+1
....S FDA(811.54,"+"_SCNT_",+"_FCNT_","_TIEN_",",.01)=VALUE
I '$D(FDA) Q
D UPDATE^DIE("E","FDA","","MSG")
I $D(MSG) D Q
.S RESULT=0
.D AWRITE^PXRMUTIL("MSG")
S RESULT=1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMTUTL 1110 printed Nov 22, 2024@16:59:40 Page 2
PXRMTUTL ;SLC/AGP - Reminder term utility routine. ;04/06/2020
+1 ;;2.0;CLINICAL REMINDERS;**72**;Feb 04, 2005;Build 16
+2 ;
+3 ;=================================
SETTFIND(RESULT,TNAME,FINDING) ;
+1 NEW FCNT,FDA,FIELD,ICNT,IENS,MSG,SCNT,SIDX,TIEN,VALUE
+2 SET TIEN=$ORDER(^PXRMD(811.5,"B",TNAME,""))
+3 IF TIEN=0
SET RESULT="-1^Reminder term "_TNAME_" not found in Reminder Term file"
QUIT
+4 SET FDA(811.5,TIEN_",",.01)=TNAME
+5 SET FCNT=TIEN
SET SCNT=0
+6 SET ICNT=0
FOR
SET ICNT=$ORDER(FINDING(ICNT))
if ICNT'>0
QUIT
Begin DoDot:1
+7 SET FIELD=""
FOR
SET FIELD=$ORDER(FINDING(ICNT,FIELD))
if FIELD=""
QUIT
Begin DoDot:2
+8 IF FIELD=.01
Begin DoDot:3
+9 IF SCNT>0
IF SCNT>0
SET FCNT=SCNT+1
QUIT
+10 SET FCNT=FCNT+1
End DoDot:3
+11 IF FIELD'="STATUS"
Begin DoDot:3
+12 SET VALUE=FINDING(ICNT,FIELD)
IF VALUE=""
QUIT
+13 SET FDA(811.52,"+"_FCNT_","_TIEN_",",FIELD)=VALUE
End DoDot:3
QUIT
+14 IF FIELD="STATUS"
Begin DoDot:3
+15 SET SCNT=FCNT
+16 SET SIDX=0
FOR
SET SIDX=$ORDER(FINDING(ICNT,FIELD,SIDX))
if SIDX'>0
QUIT
Begin DoDot:4
+17 SET VALUE=FINDING(ICNT,FIELD,SIDX)
if VALUE=""
QUIT
+18 SET SCNT=SCNT+1
+19 SET FDA(811.54,"+"_SCNT_",+"_FCNT_","_TIEN_",",.01)=VALUE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+20 IF '$DATA(FDA)
QUIT
+21 DO UPDATE^DIE("E","FDA","","MSG")
+22 IF $DATA(MSG)
Begin DoDot:1
+23 SET RESULT=0
+24 DO AWRITE^PXRMUTIL("MSG")
End DoDot:1
QUIT
+25 SET RESULT=1
+26 QUIT
+27 ;
