MCARAM6.m

MCARAM6 ;WASH ISC/JKL-MUSE LOOKUP IN DHCP ;5/2/96  12:49

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

 ;

 ;

 ;Lookup for last record in EKG file given a date/time and SSN

 ;USAGE:  S X=$$LSSN^MCARAM6(A,B,.C)

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

 ;        B=Social Security Number in consecutive digits

 ;       .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("EKG") = IEN of existing EKG record

 ;  C(1) = PID of patient, field 1, Medical Patient

 ;  C("NAME") = name of patient

 ;

 ;variables

 ;MCERR = error message

 ;

LSSN(MCDT,MCSS,MCP) ;

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

 ;       MCSS is Social Security Number in consecutive digits

 ;       MCP is array into which data is placed

 ;

 ;  Retrieves PID from SSN X-ref of Patient file

 N MCI,DIC,D,X,Y S MCP("EKG")=""

 S DIC="^DPT(",DIC(0)="XZ",D="SSN",X=MCSS D IX^DIC

 I +Y'>0 S MCERR=$$EMPSSN(MCSS,.Y) I +MCERR=55 Q MCERR

 S MCP(1)=+Y,MCP("NAME")=$P(Y(0),U)

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

 S MCI=0 F  S MCI=$O(^MCAR(691.5,"B",MCDT,MCI)) Q:MCI=""  I $D(^MCAR(691.5,"C",MCP(1),MCI)) S MCP("EKG")=MCI

 I MCP("EKG")="" S MCERR="15-PID does not exist for Date/Time" Q $$LOG^MCARAM7(MCERR)

 Q 0

 ;

ERR ;Error return

 Q MCERR

 ;

EMPSSN(MCSS,Y) ;Determine if unretrievable SSN belongs to an employee

 ;USAGE:  S X=$$EMPSSN^MCARAM6(A,.B)

 ;WHERE:  A=Social Security Number

 ;  if unsuccessful, returns an error message

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

 ;    B = patient id , B(0) = patient name

 ;

 N MCEPID,MCEMP,DIC,D,X,Y

 S MCERR="55-Social Security Number not in Patient file"

 I '$D(^DPT("SSN",MCSS)) Q MCERR

 S MCEPID=$O(^DPT("SSN",MCSS,0))

 I '$D(^DPT(MCEPID,.36)) G STYPE

 ;  Retrieves Employee entry from Eligibility Code file

SELIG S DIC="^DIC(8,",DIC(0)="XZ",D="B",X="EMPLOYEE" D IX^DIC

 I +Y'>0 G STYPE

 S MCEMP=+Y

 I ^DPT(MCEPID,.36)=MCEMP,$D(^DPT(MCEPID,0)) S Y=MCEPID,Y(0)=$P(^DPT(MCEPID,0),"^") Q 0

STYPE I '$D(^DPT(MCEPID,"TYPE")) Q MCERR

 ;  Retrieves Employee entry from Type of Patient file

 S DIC="^DG(391,",DIC(0)="XZ",D="B",X="EMPLOYEE" D IX^DIC

 I +Y'>0 Q MCERR

 S MCEMP=+Y

 I ^DPT(MCEPID,"TYPE")=MCEMP,$D(^DPT(MCEPID,0)) S Y=MCEPID,Y(0)=$P(^DPT(MCEPID,0),"^") Q 0

 Q MCERR

 ;

 ;Lookup for last record in EKG file given a date/time and full name

 ;USAGE:  S X=$$LNAME^MCARAM6(A,B,.C)

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

 ;        B=Full Name in DHCP format

 ;       .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("EKG") = IEN of existing EKG record

 ;  C(1) = PID of patient, field 1, Medical Patient

 ;  C("NAME") = name of patient

 ;

 ;variables

 ;MCERR = error message

 ;

LNAME(MCDT,MCNAME,MCP) ;

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

 ;       MCNAME is Full Name in DHCP format

 ;       MCP is array into which data is placed

 ;

 ;  Retrieves PID from Name X-ref of Patient file

 N MCI,DIC,D,X,Y S MCP("EKG")=""

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

 I +Y'>0 S MCERR=$$EMPNAME(MCNAME,.Y) I +MCERR=56 Q MCERR

 S MCP(1)=+Y,MCP("NAME")=$P(Y(0),U)

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

 S MCI=0 F  S MCI=$O(^MCAR(691.5,"B",MCDT,MCI)) Q:MCI=""  I $D(^MCAR(691.5,"C",MCP(1),MCI)) S MCP("EKG")=MCI

 I MCP("EKG")="" S MCERR="15-PID does not exist for Date/Time" Q $$LOG^MCARAM7(MCERR)

 Q 0

 ;

EMPNAME(MCNAME,Y) ;Determine if unretrievable name belongs to an employee

 ;USAGE:  S X=$$EMPNAME^MCARAM6(A,.B)

 ;WHERE:  A = Name

 ;  if unsuccessful, returns an error message

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

 ;    B = patient id , B(0) = patient name

 ;

 N MCEPID,MCEMP,DIC,D,X,Y

 S MCERR="56-Name does not match Patient file"

 I '$D(^DPT("B",MCNAME)) Q MCERR

 S MCEPID=$O(^DPT("B",MCNAME,0))

 I '$D(^DPT(MCEPID,.36)) G NTYPE

 ;  Retrieves Employee entry from Eligibility Code file

NELIG S DIC="^DIC(8,",DIC(0)="XZ",D="B",X="EMPLOYEE" D IX^DIC

 I +Y'>0 G NTYPE

 S MCEMP=+Y

 I ^DPT(MCEPID,.36)=MCEMP,$D(^DPT(MCEPID,0)) S Y=MCEPID,Y(0)=$P(^DPT(MCEPID,0),"^") Q 0

NTYPE I '$D(^DPT(MCEPID,"TYPE")) Q MCERR

 ;  Retrieves Employee entry from Type of Patient file

 S DIC="^DG(391,",DIC(0)="XZ",D="B",X="EMPLOYEE" D IX^DIC

 I +Y'>0 Q MCERR

 S MCEMP=+Y

 I ^DPT(MCEPID,"TYPE")=MCEMP,$D(^DPT(MCEPID,0)) S Y=MCEPID,Y(0)=$P(^DPT(MCEPID,0),"^") Q 0

 Q MCERR

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---MCARAM6   4671     printed  Mar 13, 2025@21:17:02                                                                                                                                                                                                     Page 2

MCARAM6   ;WASH ISC/JKL-MUSE LOOKUP IN DHCP ;5/2/96  12:49

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

 +2       ;

 +3       ;

 +4       ;Lookup for last record in EKG file given a date/time and SSN

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

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

 +7       ;        B=Social Security Number in consecutive digits

 +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("EKG") = IEN of existing EKG record

 +12      ;  C(1) = PID of patient, field 1, Medical Patient

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

 +14      ;

 +15      ;variables

 +16      ;MCERR = error message

 +17      ;

LSSN(MCDT,MCSS,MCP) ;

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

 +2       ;       MCSS is Social Security Number in consecutive digits

 +3       ;       MCP is array into which data is placed

 +4       ;

 +5       ;  Retrieves PID from SSN X-ref of Patient file

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

           SET MCP("EKG")=""

 +7        SET DIC="^DPT("

           SET DIC(0)="XZ"

           SET D="SSN"

           SET X=MCSS

           DO IX^DIC

 +8        IF +Y'>0

               SET MCERR=$$EMPSSN(MCSS,.Y)

               IF +MCERR=55

                   QUIT MCERR

 +9        SET MCP(1)=+Y

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

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

               SET MCERR="12-Date/Time not in EKG file"

               QUIT $$LOG^MCARAM7(MCERR)

 +11       SET MCI=0

           FOR 

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

               if MCI=""

                   QUIT 

               IF $DATA(^MCAR(691.5,"C",MCP(1),MCI))

                   SET MCP("EKG")=MCI

 +12       IF MCP("EKG")=""

               SET MCERR="15-PID does not exist for Date/Time"

               QUIT $$LOG^MCARAM7(MCERR)

 +13       QUIT 0

 +14      ;

ERR       ;Error return

 +1        QUIT MCERR

 +2       ;

EMPSSN(MCSS,Y) ;Determine if unretrievable SSN belongs to an employee

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

 +2       ;WHERE:  A=Social Security Number

 +3       ;  if unsuccessful, returns an error message

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

 +5       ;    B = patient id , B(0) = patient name

 +6       ;

 +7        NEW MCEPID,MCEMP,DIC,D,X,Y

 +8        SET MCERR="55-Social Security Number not in Patient file"

 +9        IF '$DATA(^DPT("SSN",MCSS))

               QUIT MCERR

 +10       SET MCEPID=$ORDER(^DPT("SSN",MCSS,0))

 +11       IF '$DATA(^DPT(MCEPID,.36))

               GOTO STYPE

 +12      ;  Retrieves Employee entry from Eligibility Code file

SELIG      SET DIC="^DIC(8,"

           SET DIC(0)="XZ"

           SET D="B"

           SET X="EMPLOYEE"

           DO IX^DIC

 +1        IF +Y'>0

               GOTO STYPE

 +2        SET MCEMP=+Y

 +3        IF ^DPT(MCEPID,.36)=MCEMP

               IF $DATA(^DPT(MCEPID,0))

                   SET Y=MCEPID

                   SET Y(0)=$PIECE(^DPT(MCEPID,0),"^")

                   QUIT 0

STYPE      IF '$DATA(^DPT(MCEPID,"TYPE"))

               QUIT MCERR

 +1       ;  Retrieves Employee entry from Type of Patient file

 +2        SET DIC="^DG(391,"

           SET DIC(0)="XZ"

           SET D="B"

           SET X="EMPLOYEE"

           DO IX^DIC

 +3        IF +Y'>0

               QUIT MCERR

 +4        SET MCEMP=+Y

 +5        IF ^DPT(MCEPID,"TYPE")=MCEMP

               IF $DATA(^DPT(MCEPID,0))

                   SET Y=MCEPID

                   SET Y(0)=$PIECE(^DPT(MCEPID,0),"^")

                   QUIT 0

 +6        QUIT MCERR

 +7       ;

 +8       ;Lookup for last record in EKG file given a date/time and full name

 +9       ;USAGE:  S X=$$LNAME^MCARAM6(A,B,.C)

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

 +11      ;        B=Full Name in DHCP format

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

 +13      ;  if unsuccessful, returns an error message

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

 +15      ;  C("EKG") = IEN of existing EKG record

 +16      ;  C(1) = PID of patient, field 1, Medical Patient

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

 +18      ;

 +19      ;variables

 +20      ;MCERR = error message

 +21      ;

LNAME(MCDT,MCNAME,MCP) ;

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

 +2       ;       MCNAME is Full Name in DHCP format

 +3       ;       MCP is array into which data is placed

 +4       ;

 +5       ;  Retrieves PID from Name X-ref of Patient file

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

           SET MCP("EKG")=""

 +7        SET DIC="^DPT("

           SET DIC(0)="XZ"

           SET D="B"

           SET X=MCNAME

           DO IX^DIC

 +8        IF +Y'>0

               SET MCERR=$$EMPNAME(MCNAME,.Y)

               IF +MCERR=56

                   QUIT MCERR

 +9        SET MCP(1)=+Y

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

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

               SET MCERR="12-Date/Time not in EKG file"

               QUIT $$LOG^MCARAM7(MCERR)

 +11       SET MCI=0

           FOR 

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

               if MCI=""

                   QUIT 

               IF $DATA(^MCAR(691.5,"C",MCP(1),MCI))

                   SET MCP("EKG")=MCI

 +12       IF MCP("EKG")=""

               SET MCERR="15-PID does not exist for Date/Time"

               QUIT $$LOG^MCARAM7(MCERR)

 +13       QUIT 0

 +14      ;

EMPNAME(MCNAME,Y) ;Determine if unretrievable name belongs to an employee

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

 +2       ;WHERE:  A = Name

 +3       ;  if unsuccessful, returns an error message

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

 +5       ;    B = patient id , B(0) = patient name

 +6       ;

 +7        NEW MCEPID,MCEMP,DIC,D,X,Y

 +8        SET MCERR="56-Name does not match Patient file"

 +9        IF '$DATA(^DPT("B",MCNAME))

               QUIT MCERR

 +10       SET MCEPID=$ORDER(^DPT("B",MCNAME,0))

 +11       IF '$DATA(^DPT(MCEPID,.36))

               GOTO NTYPE

 +12      ;  Retrieves Employee entry from Eligibility Code file

NELIG      SET DIC="^DIC(8,"

           SET DIC(0)="XZ"

           SET D="B"

           SET X="EMPLOYEE"

           DO IX^DIC

 +1        IF +Y'>0

               GOTO NTYPE

 +2        SET MCEMP=+Y

 +3        IF ^DPT(MCEPID,.36)=MCEMP

               IF $DATA(^DPT(MCEPID,0))

                   SET Y=MCEPID

                   SET Y(0)=$PIECE(^DPT(MCEPID,0),"^")

                   QUIT 0

NTYPE      IF '$DATA(^DPT(MCEPID,"TYPE"))

               QUIT MCERR

 +1       ;  Retrieves Employee entry from Type of Patient file

 +2        SET DIC="^DG(391,"

           SET DIC(0)="XZ"

           SET D="B"

           SET X="EMPLOYEE"

           DO IX^DIC

 +3        IF +Y'>0

               QUIT MCERR

 +4        SET MCEMP=+Y

 +5        IF ^DPT(MCEPID,"TYPE")=MCEMP

               IF $DATA(^DPT(MCEPID,0))

                   SET Y=MCEPID

                   SET Y(0)=$PIECE(^DPT(MCEPID,0),"^")

                   QUIT 0

 +6        QUIT MCERR