source: Scheduling/trunk/m/BSDX28.m@ 802

Last change on this file since 802 was 614, checked in by Sam Habiel, 15 years ago

Initial committ of scheduling package
File size: 4.2 KB
RevLine 
[614]1BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
2 ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
3 ;
4 ;HMW 20050721 Added test for inactivated record
5 ;
6PTLOOKRS(BSDXY,BSDXP,BSDXC) ;EP Patient Lookup
7 ;
8 ;Find up to BSDXC patients matching BSDXP*
9 ;Supports DOB Lookup, SSN Lookup
10 ;
11 S X="ERROR^BSDX28",@^%ZOSF("TRAP")
12 S BSDXP=$TR(BSDXP,$C(13),"")
13 S BSDXP=$TR(BSDXP,$C(10),"")
14 S BSDXP=$TR(BSDXP,$C(9),"")
15 S:BSDXC="" BSDXC=10
16 N BSDXHRN,BSDXZ,BSDXDLIM,BSDXRET,BSDXDPT,BSDXRET,BSDXIEN,BSDXFILE
17 N BSDXIENS,BSDXFIELDS,BSDXFLAGS,BSDXVALUE,BSDXNUMBER,BSDXINDEXES,BSDXSCREEN
18 N BSDXTARG,BSDXMSG,BSDXRSLT
19 S BSDXDLIM="^"
20 S BSDXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$C(30)
21 I '+$G(DUZ) S BSDXY=BSDXRET_$C(31) Q
22 I '$D(DUZ(2)) S BSDXY=BSDXRET_$C(31) Q
23 ;
24DOB ;DOB Lookup
25 I +DUZ(2),((BSDXP?1.2N1"/"1.2N1"/"1.4N)!(BSDXP?1.2N1" "1.2N1" "1.4N)!(BSDXP?1.2N1"-"1.2N1"-"1.4N)) D S BSDXY=BSDXRET_$C(31) Q
26 . S X=BSDXP S %DT="P" D ^%DT S BSDXP=Y Q:'+Y
27 . Q:'$D(^DPT("ADOB",BSDXP))
28 . S BSDXIEN=0 F S BSDXIEN=$O(^DPT("ADOB",BSDXP,BSDXIEN)) Q:'+BSDXIEN D
29 . . Q:'$D(^DPT(BSDXIEN,0))
30 . . S BSDXDPT=$G(^DPT(BSDXIEN,0))
31 . . S BSDXZ=$P(BSDXDPT,U) ;NAME
32 . . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
33 . . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
34 . . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
35 . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
36 . . S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
37 . . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
38 . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
39 . . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
40 . . S BSDXRET=BSDXRET_BSDXZ_$C(30)
41 . . Q
42 . Q
43 ;
44 ;Chart# Lookup
45 I +DUZ(2),BSDXP]"",$D(^AUPNPAT("D",BSDXP)) D S BSDXY=BSDXRET_$C(31) Q
46 . S BSDXIEN=0 F S BSDXIEN=$O(^AUPNPAT("D",BSDXP,BSDXIEN)) Q:'+BSDXIEN I $D(^AUPNPAT("D",BSDXP,BSDXIEN,DUZ(2))) D Q
47 . . Q:'$D(^DPT(BSDXIEN,0))
48 . . S BSDXDPT=$G(^DPT(BSDXIEN,0))
49 . . S BSDXZ=$P(BSDXDPT,U) ;NAME
50 . . S BSDXHRN=BSDXP ;CHART
51 . . I $D(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),$P(^(0),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
52 . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
53 . . S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
54 . . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
55 . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
56 . . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
57 . . S BSDXRET=BSDXRET_BSDXZ_$C(30)
58 . . Q
59 . Q
60 ;
61 ;SSN Lookup
62 I (BSDXP?9N)!(BSDXP?3N1"-"2N1"-"4N),$D(^DPT("SSN",BSDXP)) D S BSDXY=BSDXRET_$C(31) Q
63 . S BSDXIEN=0 F S BSDXIEN=$O(^DPT("SSN",BSDXP,BSDXIEN)) Q:'+BSDXIEN D Q
64 . . Q:'$D(^DPT(BSDXIEN,0))
65 . . S BSDXDPT=$G(^DPT(BSDXIEN,0))
66 . . S BSDXZ=$P(BSDXDPT,U) ;NAME
67 . . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
68 . . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
69 . . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
70 . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
71 . . S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
72 . . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
73 . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
74 . . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
75 . . S BSDXRET=BSDXRET_BSDXZ_$C(30)
76 . . Q
77 . Q
78 ;
79 S BSDXFILE=9000001
80 S BSDXIENS=""
81 S BSDXFIELDS=".01"
82 S BSDXFLAGS="M"
83 S BSDXVALUE=BSDXP
84 S BSDXNUMBER=BSDXC
85 S BSDXINDEXES=""
86 S BSDXSCREEN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0))",1:"")
87 S BSDXIDEN=""
88 S BSDXTARG="BSDXRSLT"
89 S BSDXMSG=""
90 D FIND^DIC(BSDXFILE,BSDXIENS,BSDXFIELDS,BSDXFLAGS,BSDXVALUE,BSDXNUMBER,BSDXINDEXES,BSDXSCREEN,BSDXIDEN,BSDXTARG,BSDXMSG)
91 I '+$G(BSDXRSLT("DILIST",0)) S BSDXY=BSDXRET_$C(31) Q
92 N BSDXCNT S BSDXCNT=2
93 F BSDXX=1:1:$P(BSDXRSLT("DILIST",0),U) D
94 . S BSDXIEN=BSDXRSLT("DILIST",2,BSDXX)
95 . S BSDXZ=BSDXRSLT("DILIST","ID",BSDXX,.01) ;NAME
96 . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
97 . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
98 . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
99 . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
100 . S BSDXDPT=$G(^DPT(BSDXIEN,0))
101 . S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
102 . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
103 . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
104 . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
105 . S $P(BSDXRET,$C(30),BSDXCNT)=BSDXZ
106 . S BSDXCNT=BSDXCNT+1
107 . Q
108 S BSDXY=BSDXRET_$C(30)_$C(31)
109 Q
110 ;
111ERROR ;
112 D ERR("RPMS Error")
113 Q
114 ;
115ERR(ERRNO) ;Error processing
116 S BSDXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$C(30)_"^^^^"_$C(30)_$C(31)
117 Q
Note: See TracBrowser for help on using the repository browser.