PXRMACT.m

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

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