MCARAM7.m

MCARAM7 ;WASH ISC/JKL-MUSE SUMMARY LOOKUP AND FILE IN DHCP ;6/26/96  12:27

 ;;2.3;Medicine;;09/13/1996

 ;

 ;

 ;Lookup for last transmission in Summary file 700.5

 ;USAGE:  S X=$$LSUM^MCARAM7(A,B,.C)

 ;WHERE:  A=Date/time of record in FileMan format

 ;        B=Name of patient equivalent to name in Patient file (#2)

 ;       .C=Array into which data is placed

 ;  if unsuccessful, returns an error message

 ;  if successful, returns a function value of 0 and a value array:

 ;  C("SUM") = IEN of existing Summary record

 ;  C("PID") = PID of patient

 ;  C("NAME") = name of patient

 ;

 ;variables

 ;MCERR = error message

 ;

LSUM(MCDT,MCNM,MCS) ;

 ; Where MCDT is Date/time of record in FileMan format

 ;       MCNM is Name of patient equivalent to name in Patient file (#2)

 ;       MCS is array into which data is placed

 ;

 ;  Retrieves PID from Name X-ref of Patient file (#2)

 N MCI,DIC,D,X,Y,MCERR S MCS("SUM")=""

 S DIC="^DPT(",DIC(0)="XZ",D="B",X=MCNM D IX^DIC

 I +Y'>0 S MCERR="21-Name for Summary not in Patient file" Q $$LOG^MCARAM7(MCERR)

 S MCS("PID")=+Y,MCS("NAME")=$P(Y(0),U)

 I '$D(^MCAR(700.5,"B",MCDT)) S MCERR="22-Date/Time not in Summary file" Q $$LOG^MCARAM7(MCERR)

 S MCI=0 F  S MCI=$O(^MCAR(700.5,"B",MCDT,MCI)) Q:MCI=""  I $D(^MCAR(700.5,"PT",MCS("NAME"),MCI)) S MCS("SUM")=MCI

 I MCS("SUM")="" S MCERR="23-Name does not exist for Date/Time in Summary file" Q $$LOG^MCARAM7(MCERR)

 Q 0

 ;

KPERR(MCA,MCS) ;Transfer local array data into new 700.5 Summary record in DHCP

 ; occurs for every data transfer attempt whether or not successful

 ;USAGE:  S X=$$KPERR^MCARAM7(.A,.B)

 ;WHERE:  A=Array of local data arranged for EKG file

 ;        B=DHCP data stored in Summary file including

 ;          B("SUM")=IEN of Summary file

 ;  if unsuccessful, returns an error message

 ;  if successful, returns a function value of 0

 ; MCS("FLDT")=Creation date in 700.5, file date/time 

 ;

 ; Number of attempts of same data record, field 5

 ; Obsolete with transaction processing, still needed for MCARAP* report

 N MCI,%,DIC,X,Y,MCERR

 S MCS(5)=1

 ; Date/Time Initial, creation of entry in Summary file, field .05

 D NOW^%DTC S (MCS("FLDT"),MCS(.05),MCS(.06))=%

 ; Date/Time Latest, latest transmission attempt, field .06

 ; Transaction processing makes latest transmission date/time

 ; same as initial date/time except for those with imaging updates

 ; Auto instrument name, defined in MCARAM, field 1

 S MCS(1)=MCINST

 ; Reason for failure to pass DHCP validity checks, field 4

 S MCS(4)=$$RFFL(.MCA,.MCS)

 ; Social Security Number, field 2

 S MCS(2)=MCA(.02)

 ; Name, field 3

 S MCS(3)=MCA("NAME")

 ; Type of transmission, field 7

 S MCS(7)=MCTYPE

 S MCI=.05,DIC("DR")=".05///"_MCS(.05) F  S MCI=$O(MCS(MCI)) Q:MCI=""!(MCI?1A.A)  S DIC("DR")=DIC("DR")_";"_MCI_"///"_MCS(MCI)

 K DD,DO N DLAYGO S DLAYGO=700.5,DIC="^MCAR(700.5,",DIC(0)="LXZ",X=MCA("DT")

 D FILE^DICN

 I +Y>0 S MCS("SUM")=+Y Q 0

 S MCERR="9-Summary record not filed" Q $$LOG^MCARAM7(MCERR)

 ;

RFFL(MCA,MCS) ; Convert processing errors to 700.5 file fields

 ;USAGE:  S X=$$RFFL^MCARAM7(.A,.B)

 ;WHERE:  A=Array of local data

 ;        B=DHCP data for Summary file including

 ;          B("SUM")=internal record number of Summary file

 ; returns field 4 of 700.5 file, reason for failure

 ;   field 4 : "D"ate/Time error, "L"oad into DHCP error

 ;             "N"ame error, "S"ocial Security Number error

 ;      Integers for specific errors listed in the Summary Print,

 ;      MCARAP2 - Errors numbered >50 have not been filed as EKG records

 ; returns field 6 of 700.5 file, error code for last transmission

 ;   field 6 : "S"uccessful or "U"nsuccessful

 ; MCA("ERR") = # of processing errors

 ;successful transfer attempt

 S MCS(6)="S" I $$GRERR(.MCA)=0 Q ""

 ;unsuccessful transfer attempt

 S MCS(6)="U",MCERR=+MCA("ERR",0)

 I +MCERR=51!(+MCERR=52)!(+MCERR=53) S:$G(MCA("DT"))="" MCA("DT")=MCS("FLDT")

 Q $S(+MCERR>62:"P",+MCERR>60:"M",+MCERR>57:"L",+MCERR>55:"N",+MCERR>53:"S",+MCERR>50:"D",1:+MCERR)

 ;

GRERR(MCA) ;Find first fatal error

 ;USAGE:  S X=$$GRERR(A)

 ;WHERE:  A=array of local data

 ;        if successful, returns 1 and A("ERR",0)=first fatal error >50

 ;        if unsuccessful, returns 0

 ;variables MCERR,MCI,MCJ

 N MCERR,MCI,MCJ

 I MCA("ERR")=0 Q 0

 S MCI=MCA("ERR") F MCJ=1:1:MCI I +MCA("ERR",MCJ)>50 S MCERR=MCA("ERR",MCJ) Q

 I $D(MCERR) S MCA("ERR",0)=MCERR Q 1

 Q 0

 ;

LOG(MCERR) ;Logs type of error in local array

 ;USAGE:  S X=$$LOG^MCARAM7(A)

 ;WHERE:  A=Free text error

 ;  returns the error message and updates the error array

 S MCA("ERR")=MCA("ERR")+1,MCA("ERR",MCA("ERR"))=MCERR

 Q MCERR

MCARAM7   ;WASH ISC/JKL-MUSE SUMMARY LOOKUP AND FILE IN DHCP ;6/26/96  12:27

 +1       ;;2.3;Medicine;;09/13/1996

 +2       ;

 +3       ;

 +4       ;Lookup for last transmission in Summary file 700.5

 +5       ;USAGE:  S X=$$LSUM^MCARAM7(A,B,.C)

 +6       ;WHERE:  A=Date/time of record in FileMan format

 +7       ;        B=Name of patient equivalent to name in Patient file (#2)

 +8       ;       .C=Array into which data is placed

 +9       ;  if unsuccessful, returns an error message

 +10      ;  if successful, returns a function value of 0 and a value array:

 +11      ;  C("SUM") = IEN of existing Summary record

 +12      ;  C("PID") = PID of patient

 +13      ;  C("NAME") = name of patient

 +14      ;

 +15      ;variables

 +16      ;MCERR = error message

 +17      ;

LSUM(MCDT,MCNM,MCS) ;

 +1       ; Where MCDT is Date/time of record in FileMan format

 +2       ;       MCNM is Name of patient equivalent to name in Patient file (#2)

 +3       ;       MCS is array into which data is placed

 +4       ;

 +5       ;  Retrieves PID from Name X-ref of Patient file (#2)

 +6        NEW MCI,DIC,D,X,Y,MCERR

           SET MCS("SUM")=""

 +7        SET DIC="^DPT("

           SET DIC(0)="XZ"

           SET D="B"

           SET X=MCNM

           DO IX^DIC

 +8        IF +Y'>0

               SET MCERR="21-Name for Summary not in Patient file"

               QUIT $$LOG^MCARAM7(MCERR)

 +9        SET MCS("PID")=+Y

           SET MCS("NAME")=$PIECE(Y(0),U)

 +10       IF '$DATA(^MCAR(700.5,"B",MCDT))

               SET MCERR="22-Date/Time not in Summary file"

               QUIT $$LOG^MCARAM7(MCERR)

 +11       SET MCI=0

           FOR 

               SET MCI=$ORDER(^MCAR(700.5,"B",MCDT,MCI))

               IF MCI=""

                   QUIT 

               IF $DATA(^MCAR(700.5,"PT",MCS("NAME"),MCI))

                   SET MCS("SUM")=MCI

 +12       IF MCS("SUM")=""

               SET MCERR="23-Name does not exist for Date/Time in Summary file"

               QUIT $$LOG^MCARAM7(MCERR)

 +13       QUIT 0

 +14      ;

KPERR(MCA,MCS) ;Transfer local array data into new 700.5 Summary record in DHCP

 +1       ; occurs for every data transfer attempt whether or not successful

 +2       ;USAGE:  S X=$$KPERR^MCARAM7(.A,.B)

 +3       ;WHERE:  A=Array of local data arranged for EKG file

 +4       ;        B=DHCP data stored in Summary file including

 +5       ;          B("SUM")=IEN of Summary file

 +6       ;  if unsuccessful, returns an error message

 +7       ;  if successful, returns a function value of 0

 +8       ; MCS("FLDT")=Creation date in 700.5, file date/time 

 +9       ;

 +10      ; Number of attempts of same data record, field 5

 +11      ; Obsolete with transaction processing, still needed for MCARAP* report

 +12       NEW MCI,%,DIC,X,Y,MCERR

 +13       SET MCS(5)=1

 +14      ; Date/Time Initial, creation of entry in Summary file, field .05

 +15       DO NOW^%DTC

           SET (MCS("FLDT"),MCS(.05),MCS(.06))=%

 +16      ; Date/Time Latest, latest transmission attempt, field .06

 +17      ; Transaction processing makes latest transmission date/time

 +18      ; same as initial date/time except for those with imaging updates

 +19      ; Auto instrument name, defined in MCARAM, field 1

 +20       SET MCS(1)=MCINST

 +21      ; Reason for failure to pass DHCP validity checks, field 4

 +22       SET MCS(4)=$$RFFL(.MCA,.MCS)

 +23      ; Social Security Number, field 2

 +24       SET MCS(2)=MCA(.02)

 +25      ; Name, field 3

 +26       SET MCS(3)=MCA("NAME")

 +27      ; Type of transmission, field 7

 +28       SET MCS(7)=MCTYPE

 +29       SET MCI=.05

           SET DIC("DR")=".05///"_MCS(.05)

           FOR 

               SET MCI=$ORDER(MCS(MCI))

               IF MCI=""!(MCI?1A.A)

                   QUIT 

               SET DIC("DR")=DIC("DR")_";"_MCI_"///"_MCS(MCI)

 +30       KILL DD,DO

           NEW DLAYGO

           SET DLAYGO=700.5

           SET DIC="^MCAR(700.5,"

           SET DIC(0)="LXZ"

           SET X=MCA("DT")

 +31       DO FILE^DICN

 +32       IF +Y>0

               SET MCS("SUM")=+Y

               QUIT 0

 +33       SET MCERR="9-Summary record not filed"

           QUIT $$LOG^MCARAM7(MCERR)

 +34      ;

RFFL(MCA,MCS) ; Convert processing errors to 700.5 file fields

 +1       ;USAGE:  S X=$$RFFL^MCARAM7(.A,.B)

 +2       ;WHERE:  A=Array of local data

 +3       ;        B=DHCP data for Summary file including

 +4       ;          B("SUM")=internal record number of Summary file

 +5       ; returns field 4 of 700.5 file, reason for failure

 +6       ;   field 4 : "D"ate/Time error, "L"oad into DHCP error

 +7       ;             "N"ame error, "S"ocial Security Number error

 +8       ;      Integers for specific errors listed in the Summary Print,

 +9       ;      MCARAP2 - Errors numbered >50 have not been filed as EKG records

 +10      ; returns field 6 of 700.5 file, error code for last transmission

 +11      ;   field 6 : "S"uccessful or "U"nsuccessful

 +12      ; MCA("ERR") = # of processing errors

 +13      ;successful transfer attempt

 +14       SET MCS(6)="S"

           IF $$GRERR(.MCA)=0

               QUIT ""

 +15      ;unsuccessful transfer attempt

 +16       SET MCS(6)="U"

           SET MCERR=+MCA("ERR",0)

 +17       IF +MCERR=51!(+MCERR=52)!(+MCERR=53)

               IF $GET(MCA("DT"))=""

                   SET MCA("DT")=MCS("FLDT")

 +18       QUIT $SELECT(+MCERR>62:"P",+MCERR>60:"M",+MCERR>57:"L",+MCERR>55:"N",+MCERR>53:"S",+MCERR>50:"D",1:+MCERR)

 +19      ;

GRERR(MCA) ;Find first fatal error

 +1       ;USAGE:  S X=$$GRERR(A)

 +2       ;WHERE:  A=array of local data

 +3       ;        if successful, returns 1 and A("ERR",0)=first fatal error >50

 +4       ;        if unsuccessful, returns 0

 +5       ;variables MCERR,MCI,MCJ

 +6        NEW MCERR,MCI,MCJ

 +7        IF MCA("ERR")=0

               QUIT 0

 +8        SET MCI=MCA("ERR")

           FOR MCJ=1:1:MCI

               IF +MCA("ERR",MCJ)>50

                   SET MCERR=MCA("ERR",MCJ)

                   QUIT 

 +9        IF $DATA(MCERR)

               SET MCA("ERR",0)=MCERR

               QUIT 1

 +10       QUIT 0

 +11      ;

LOG(MCERR) ;Logs type of error in local array

 +1       ;USAGE:  S X=$$LOG^MCARAM7(A)

 +2       ;WHERE:  A=Free text error

 +3       ;  returns the error message and updates the error array

 +4        SET MCA("ERR")=MCA("ERR")+1

           SET MCA("ERR",MCA("ERR"))=MCERR

 +5        QUIT MCERR