| 1 | MCARAM6 ;WASH ISC/JKL-MUSE LOOKUP IN DHCP ;5/2/96 12:49
|
|---|
| 2 | ;;2.3;Medicine;;09/13/1996
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | ;Lookup for last record in EKG file given a date/time and SSN
|
|---|
| 6 | ;USAGE: S X=$$LSSN^MCARAM6(A,B,.C)
|
|---|
| 7 | ;WHERE: A=Date/time of record in FileMan format
|
|---|
| 8 | ; B=Social Security Number in consecutive digits
|
|---|
| 9 | ; .C=Array into which data is placed
|
|---|
| 10 | ; if unsuccessful, returns an error message
|
|---|
| 11 | ; if successful, returns a function value of 0 and a value array:
|
|---|
| 12 | ; C("EKG") = IEN of existing EKG record
|
|---|
| 13 | ; C(1) = PID of patient, field 1, Medical Patient
|
|---|
| 14 | ; C("NAME") = name of patient
|
|---|
| 15 | ;
|
|---|
| 16 | ;variables
|
|---|
| 17 | ;MCERR = error message
|
|---|
| 18 | ;
|
|---|
| 19 | LSSN(MCDT,MCSS,MCP) ;
|
|---|
| 20 | ; Where MCDT is Date/time of record in FileMan format
|
|---|
| 21 | ; MCSS is Social Security Number in consecutive digits
|
|---|
| 22 | ; MCP is array into which data is placed
|
|---|
| 23 | ;
|
|---|
| 24 | ; Retrieves PID from SSN X-ref of Patient file
|
|---|
| 25 | N MCI,DIC,D,X,Y S MCP("EKG")=""
|
|---|
| 26 | S DIC="^DPT(",DIC(0)="XZ",D="SSN",X=MCSS D IX^DIC
|
|---|
| 27 | I +Y'>0 S MCERR=$$EMPSSN(MCSS,.Y) I +MCERR=55 Q MCERR
|
|---|
| 28 | S MCP(1)=+Y,MCP("NAME")=$P(Y(0),U)
|
|---|
| 29 | I '$D(^MCAR(691.5,"B",MCDT)) S MCERR="12-Date/Time not in EKG file" Q $$LOG^MCARAM7(MCERR)
|
|---|
| 30 | 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
|
|---|
| 31 | I MCP("EKG")="" S MCERR="15-PID does not exist for Date/Time" Q $$LOG^MCARAM7(MCERR)
|
|---|
| 32 | Q 0
|
|---|
| 33 | ;
|
|---|
| 34 | ERR ;Error return
|
|---|
| 35 | Q MCERR
|
|---|
| 36 | ;
|
|---|
| 37 | EMPSSN(MCSS,Y) ;Determine if unretrievable SSN belongs to an employee
|
|---|
| 38 | ;USAGE: S X=$$EMPSSN^MCARAM6(A,.B)
|
|---|
| 39 | ;WHERE: A=Social Security Number
|
|---|
| 40 | ; if unsuccessful, returns an error message
|
|---|
| 41 | ; if successful, returns a function value of 0 and an array:
|
|---|
| 42 | ; B = patient id , B(0) = patient name
|
|---|
| 43 | ;
|
|---|
| 44 | N MCEPID,MCEMP,DIC,D,X,Y
|
|---|
| 45 | S MCERR="55-Social Security Number not in Patient file"
|
|---|
| 46 | I '$D(^DPT("SSN",MCSS)) Q MCERR
|
|---|
| 47 | S MCEPID=$O(^DPT("SSN",MCSS,0))
|
|---|
| 48 | I '$D(^DPT(MCEPID,.36)) G STYPE
|
|---|
| 49 | ; Retrieves Employee entry from Eligibility Code file
|
|---|
| 50 | SELIG S DIC="^DIC(8,",DIC(0)="XZ",D="B",X="EMPLOYEE" D IX^DIC
|
|---|
| 51 | I +Y'>0 G STYPE
|
|---|
| 52 | S MCEMP=+Y
|
|---|
| 53 | I ^DPT(MCEPID,.36)=MCEMP,$D(^DPT(MCEPID,0)) S Y=MCEPID,Y(0)=$P(^DPT(MCEPID,0),"^") Q 0
|
|---|
| 54 | STYPE I '$D(^DPT(MCEPID,"TYPE")) Q MCERR
|
|---|
| 55 | ; Retrieves Employee entry from Type of Patient file
|
|---|
| 56 | S DIC="^DG(391,",DIC(0)="XZ",D="B",X="EMPLOYEE" D IX^DIC
|
|---|
| 57 | I +Y'>0 Q MCERR
|
|---|
| 58 | S MCEMP=+Y
|
|---|
| 59 | I ^DPT(MCEPID,"TYPE")=MCEMP,$D(^DPT(MCEPID,0)) S Y=MCEPID,Y(0)=$P(^DPT(MCEPID,0),"^") Q 0
|
|---|
| 60 | Q MCERR
|
|---|
| 61 | ;
|
|---|
| 62 | ;Lookup for last record in EKG file given a date/time and full name
|
|---|
| 63 | ;USAGE: S X=$$LNAME^MCARAM6(A,B,.C)
|
|---|
| 64 | ;WHERE: A=Date/time of record in FileMan format
|
|---|
| 65 | ; B=Full Name in DHCP format
|
|---|
| 66 | ; .C=Array into which data is placed
|
|---|
| 67 | ; if unsuccessful, returns an error message
|
|---|
| 68 | ; if successful, returns a function value of 0 and a value array:
|
|---|
| 69 | ; C("EKG") = IEN of existing EKG record
|
|---|
| 70 | ; C(1) = PID of patient, field 1, Medical Patient
|
|---|
| 71 | ; C("NAME") = name of patient
|
|---|
| 72 | ;
|
|---|
| 73 | ;variables
|
|---|
| 74 | ;MCERR = error message
|
|---|
| 75 | ;
|
|---|
| 76 | LNAME(MCDT,MCNAME,MCP) ;
|
|---|
| 77 | ; Where MCDT is Date/time of record in FileMan format
|
|---|
| 78 | ; MCNAME is Full Name in DHCP format
|
|---|
| 79 | ; MCP is array into which data is placed
|
|---|
| 80 | ;
|
|---|
| 81 | ; Retrieves PID from Name X-ref of Patient file
|
|---|
| 82 | N MCI,DIC,D,X,Y S MCP("EKG")=""
|
|---|
| 83 | S DIC="^DPT(",DIC(0)="XZ",D="B",X=MCNAME D IX^DIC
|
|---|
| 84 | I +Y'>0 S MCERR=$$EMPNAME(MCNAME,.Y) I +MCERR=56 Q MCERR
|
|---|
| 85 | S MCP(1)=+Y,MCP("NAME")=$P(Y(0),U)
|
|---|
| 86 | I '$D(^MCAR(691.5,"B",MCDT)) S MCERR="12-Date/Time not in EKG file" Q $$LOG^MCARAM7(MCERR)
|
|---|
| 87 | 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
|
|---|
| 88 | I MCP("EKG")="" S MCERR="15-PID does not exist for Date/Time" Q $$LOG^MCARAM7(MCERR)
|
|---|
| 89 | Q 0
|
|---|
| 90 | ;
|
|---|
| 91 | EMPNAME(MCNAME,Y) ;Determine if unretrievable name belongs to an employee
|
|---|
| 92 | ;USAGE: S X=$$EMPNAME^MCARAM6(A,.B)
|
|---|
| 93 | ;WHERE: A = Name
|
|---|
| 94 | ; if unsuccessful, returns an error message
|
|---|
| 95 | ; if successful, returns a function value of 0 and an array:
|
|---|
| 96 | ; B = patient id , B(0) = patient name
|
|---|
| 97 | ;
|
|---|
| 98 | N MCEPID,MCEMP,DIC,D,X,Y
|
|---|
| 99 | S MCERR="56-Name does not match Patient file"
|
|---|
| 100 | I '$D(^DPT("B",MCNAME)) Q MCERR
|
|---|
| 101 | S MCEPID=$O(^DPT("B",MCNAME,0))
|
|---|
| 102 | I '$D(^DPT(MCEPID,.36)) G NTYPE
|
|---|
| 103 | ; Retrieves Employee entry from Eligibility Code file
|
|---|
| 104 | NELIG S DIC="^DIC(8,",DIC(0)="XZ",D="B",X="EMPLOYEE" D IX^DIC
|
|---|
| 105 | I +Y'>0 G NTYPE
|
|---|
| 106 | S MCEMP=+Y
|
|---|
| 107 | I ^DPT(MCEPID,.36)=MCEMP,$D(^DPT(MCEPID,0)) S Y=MCEPID,Y(0)=$P(^DPT(MCEPID,0),"^") Q 0
|
|---|
| 108 | NTYPE I '$D(^DPT(MCEPID,"TYPE")) Q MCERR
|
|---|
| 109 | ; Retrieves Employee entry from Type of Patient file
|
|---|
| 110 | S DIC="^DG(391,",DIC(0)="XZ",D="B",X="EMPLOYEE" D IX^DIC
|
|---|
| 111 | I +Y'>0 Q MCERR
|
|---|
| 112 | S MCEMP=+Y
|
|---|
| 113 | I ^DPT(MCEPID,"TYPE")=MCEMP,$D(^DPT(MCEPID,0)) S Y=MCEPID,Y(0)=$P(^DPT(MCEPID,0),"^") Q 0
|
|---|
| 114 | Q MCERR
|
|---|
