PXRMACT ; SLC/PJH - Activity File Update ;06/03/1999
;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
;
; This is a bit ruff 'cos we don't have a file to update yet
;
;Initialize fields
START N PXRMITEM,DFN,ADATE,ATYPE,RDATE,EDATE,STATUS,NDATE,ROLL,EPROC,AEDATE
N PSEX,AAGE,DOD,AFAC,HLOC,SPEC,CSTOP,CSEX,MINAGE,MAXAGE
;
;Get patient cache items
D CACHE
;Get finding items
D FIND
;Update Activity file
D UPD
;
END Q
;
;Get Cache items
;---------------
CACHE Q
;
;Get Finding Items
FIND Q
;
;Create activity record - file #801 ??
;-------------------------------------
UPD N ARRAY,DATA,DESC,IEN,STRING,SUB,TAG,FDA,FDAIEN
;Get each reminder in turn
S STRING="Building activity record"
D BMES^XPDUTL(STRING)
;Build FDA array
K FDAIEN,FDA
S FDA(801,"+1,",.01)=PXRMITEM
S FDA(801,"+1,",.02)=DFN
S FDA(801,"+1,",.03)=ADATE
S FDA(801,"+1,",.04)=ATYPE
S FDA(801,"+1,",.05)=RDATE
S FDA(801,"+1,",.06)=EDATE
S FDA(801,"+1,",.07)=STATUS
S FDA(801,"+1,",.08)=NDATE
S FDA(801,"+1,",.09)=ROLL
S FDA(801,"+1,",.1)=EPROC
S FDA(801,"+1,",.11)=AEDATE
S FDA(801,"+1,",2.01)=PSEX
S FDA(801,"+1,",2.02)=AAGE
S FDA(801,"+1,",2.03)=DOD
S FDA(801,"+1,",4.01)=AFAC
S FDA(801,"+1,",4.02)=HLOC
S FDA(801,"+1,",4.03)=SPEC
S FDA(801,"+1,",4.04)=CSTOP
S FDA(801,"+1,",7.01)=CSEX
S FDA(801,"+1,",7.02)=MINAGE
S FDA(801,"+1,",7.03)=MAXAGE
;
;Store findings multiple(s)
N CNT S CNT=0
D MFDA(801.002,"?","?")
D MFDA(801.002,"?","?")
D MFDA(801.002,"?","?")
D MFDA(801.002,"?","?")
D MFDA(801.002,"?","?")
;
S FDA(801,"+1,",200.1)="?"
D UPDATE^DIE("","FDA","FDAIEN","MSG")
I $D(MSG) D ERR
Q
;
MFDA(FILE,FIELD,DATA) ;
I FIELD=".01" S CNT=CNT+1
S FDA(FILE,"+"_CNT_",?1,",FIELD)=DATA
Q
;
;Error Handler
;-------------
ERR N ERROR,IC,REF
S ERROR(1)="Error in UPDATE^DIE, needs further investigation"
;Move MSG into ERROR
S REF="MSG"
F IC=2:1 S REF=$Q(@REF) Q:REF="" S ERROR(IC)=REF_"="_@REF
;Screen message
D BMES^XPDUTL(.ERROR)
;Mail Message - this should become a standard facility
;D ERR^PXRMPV1E(.ERROR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMACT 2123 printed Apr 09, 2024@20:55:02 Page 2
PXRMACT ; SLC/PJH - Activity File Update ;06/03/1999
+1 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+2 ;
+3 ; This is a bit ruff 'cos we don't have a file to update yet
+4 ;
+5 ;Initialize fields
START NEW PXRMITEM,DFN,ADATE,ATYPE,RDATE,EDATE,STATUS,NDATE,ROLL,EPROC,AEDATE
+1 NEW PSEX,AAGE,DOD,AFAC,HLOC,SPEC,CSTOP,CSEX,MINAGE,MAXAGE
+2 ;
+3 ;Get patient cache items
+4 DO CACHE
+5 ;Get finding items
+6 DO FIND
+7 ;Update Activity file
+8 DO UPD
+9 ;
END QUIT
+1 ;
+2 ;Get Cache items
+3 ;---------------
CACHE QUIT
+1 ;
+2 ;Get Finding Items
FIND QUIT
+1 ;
+2 ;Create activity record - file #801 ??
+3 ;-------------------------------------
UPD NEW ARRAY,DATA,DESC,IEN,STRING,SUB,TAG,FDA,FDAIEN
+1 ;Get each reminder in turn
+2 SET STRING="Building activity record"
+3 DO BMES^XPDUTL(STRING)
+4 ;Build FDA array
+5 KILL FDAIEN,FDA
+6 SET FDA(801,"+1,",.01)=PXRMITEM
+7 SET FDA(801,"+1,",.02)=DFN
+8 SET FDA(801,"+1,",.03)=ADATE
+9 SET FDA(801,"+1,",.04)=ATYPE
+10 SET FDA(801,"+1,",.05)=RDATE
+11 SET FDA(801,"+1,",.06)=EDATE
+12 SET FDA(801,"+1,",.07)=STATUS
+13 SET FDA(801,"+1,",.08)=NDATE
+14 SET FDA(801,"+1,",.09)=ROLL
+15 SET FDA(801,"+1,",.1)=EPROC
+16 SET FDA(801,"+1,",.11)=AEDATE
+17 SET FDA(801,"+1,",2.01)=PSEX
+18 SET FDA(801,"+1,",2.02)=AAGE
+19 SET FDA(801,"+1,",2.03)=DOD
+20 SET FDA(801,"+1,",4.01)=AFAC
+21 SET FDA(801,"+1,",4.02)=HLOC
+22 SET FDA(801,"+1,",4.03)=SPEC
+23 SET FDA(801,"+1,",4.04)=CSTOP
+24 SET FDA(801,"+1,",7.01)=CSEX
+25 SET FDA(801,"+1,",7.02)=MINAGE
+26 SET FDA(801,"+1,",7.03)=MAXAGE
+27 ;
+28 ;Store findings multiple(s)
+29 NEW CNT
SET CNT=0
+30 DO MFDA(801.002,"?","?")
+31 DO MFDA(801.002,"?","?")
+32 DO MFDA(801.002,"?","?")
+33 DO MFDA(801.002,"?","?")
+34 DO MFDA(801.002,"?","?")
+35 ;
+36 SET FDA(801,"+1,",200.1)="?"
+37 DO UPDATE^DIE("","FDA","FDAIEN","MSG")
+38 IF $DATA(MSG)
DO ERR
+39 QUIT
+40 ;
MFDA(FILE,FIELD,DATA) ;
+1 IF FIELD=".01"
SET CNT=CNT+1
+2 SET FDA(FILE,"+"_CNT_",?1,",FIELD)=DATA
+3 QUIT
+4 ;
+5 ;Error Handler
+6 ;-------------
ERR NEW ERROR,IC,REF
+1 SET ERROR(1)="Error in UPDATE^DIE, needs further investigation"
+2 ;Move MSG into ERROR
+3 SET REF="MSG"
+4 FOR IC=2:1
SET REF=$QUERY(@REF)
if REF=""
QUIT
SET ERROR(IC)=REF_"="_@REF
+5 ;Screen message
+6 DO BMES^XPDUTL(.ERROR)
+7 ;Mail Message - this should become a standard facility
+8 ;D ERR^PXRMPV1E(.ERROR)
+9 QUIT
