source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCARAM6.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1MCARAM6 ;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 ;
19LSSN(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 ;
34ERR ;Error return
35 Q MCERR
36 ;
37EMPSSN(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
50SELIG 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
54STYPE 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 ;
76LNAME(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 ;
91EMPNAME(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
104NELIG 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
108NTYPE 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
Note: See TracBrowser for help on using the repository browser.