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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARAM7 4709 printed Nov 22, 2024@17:22:09 Page 2
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
