- 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 Jan 18, 2025@02:44:08 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