[867] | 1 | BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/10 3:55pm
|
---|
[614] | 2 | ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
|
---|
| 3 | ;
|
---|
[867] | 4 | ; HMW 3050721 Added test for inactivated record
|
---|
| 5 | ; SMH 3100714 add PID search, return PID instead of SSN
|
---|
| 6 | ; Change Error trap to new style.
|
---|
[614] | 7 | ;
|
---|
| 8 | PTLOOKRS(BSDXY,BSDXP,BSDXC) ;EP Patient Lookup
|
---|
| 9 | ;
|
---|
| 10 | ;Find up to BSDXC patients matching BSDXP*
|
---|
[867] | 11 | ;Supports DOB Lookup, Primary Long ID lookup
|
---|
[614] | 12 | ;
|
---|
[867] | 13 | N $ET S $ET="G ERROR^BSDX28"
|
---|
| 14 | ; rm ctrl chars
|
---|
[614] | 15 | S BSDXP=$TR(BSDXP,$C(13),"")
|
---|
| 16 | S BSDXP=$TR(BSDXP,$C(10),"")
|
---|
| 17 | S BSDXP=$TR(BSDXP,$C(9),"")
|
---|
[867] | 18 | ; num of pts to find
|
---|
[614] | 19 | S:BSDXC="" BSDXC=10
|
---|
| 20 | N BSDXHRN,BSDXZ,BSDXDLIM,BSDXRET,BSDXDPT,BSDXRET,BSDXIEN,BSDXFILE
|
---|
| 21 | N BSDXIENS,BSDXFIELDS,BSDXFLAGS,BSDXVALUE,BSDXNUMBER,BSDXINDEXES,BSDXSCREEN
|
---|
| 22 | N BSDXTARG,BSDXMSG,BSDXRSLT
|
---|
| 23 | S BSDXDLIM="^"
|
---|
[867] | 24 | S BSDXRET="T00030NAME^T00030HRN^T00030PID^D00030DOB^T00030IEN"_$C(30)
|
---|
[614] | 25 | I '+$G(DUZ) S BSDXY=BSDXRET_$C(31) Q
|
---|
| 26 | I '$D(DUZ(2)) S BSDXY=BSDXRET_$C(31) Q
|
---|
[867] | 27 |
|
---|
| 28 | PID ;PID Lookup
|
---|
| 29 | ; If this ID exists, go get it. If "UJOPID" index doesn't exist,
|
---|
| 30 | ; won't work anyways.
|
---|
| 31 | I $D(^DPT("UJOPID",BSDXP)) DO SET BSDXY=BSDXRET_$C(31) QUIT
|
---|
| 32 | . S BSDXIEN=$O(^DPT("UJOPID",BSDXP,""))
|
---|
| 33 | . Q:'$D(^DPT(BSDXIEN,0))
|
---|
| 34 | . S BSDXDPT=$G(^DPT(BSDXIEN,0))
|
---|
| 35 | . S BSDXZ=$P(BSDXDPT,U) ;NAME
|
---|
| 36 | . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
|
---|
| 37 | . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
|
---|
| 38 | . ; Inactivated Chart get an *
|
---|
| 39 | . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q
|
---|
| 40 | . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
|
---|
| 41 | . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
|
---|
| 42 | . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
|
---|
| 43 | . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
|
---|
| 44 | . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
|
---|
| 45 | . S BSDXRET=BSDXRET_BSDXZ_$C(30)
|
---|
[614] | 46 | ;
|
---|
| 47 | DOB ;DOB Lookup
|
---|
| 48 | 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
|
---|
| 49 | . S X=BSDXP S %DT="P" D ^%DT S BSDXP=Y Q:'+Y
|
---|
| 50 | . Q:'$D(^DPT("ADOB",BSDXP))
|
---|
| 51 | . S BSDXIEN=0 F S BSDXIEN=$O(^DPT("ADOB",BSDXP,BSDXIEN)) Q:'+BSDXIEN D
|
---|
| 52 | . . Q:'$D(^DPT(BSDXIEN,0))
|
---|
| 53 | . . S BSDXDPT=$G(^DPT(BSDXIEN,0))
|
---|
| 54 | . . S BSDXZ=$P(BSDXDPT,U) ;NAME
|
---|
| 55 | . . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
|
---|
| 56 | . . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
|
---|
| 57 | . . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
|
---|
| 58 | . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
|
---|
[867] | 59 | . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
|
---|
[614] | 60 | . . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
|
---|
| 61 | . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
|
---|
| 62 | . . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
|
---|
| 63 | . . S BSDXRET=BSDXRET_BSDXZ_$C(30)
|
---|
| 64 | . . Q
|
---|
| 65 | . Q
|
---|
| 66 | ;
|
---|
[867] | 67 | CHART
|
---|
| 68 | ;Chart# Lookup
|
---|
[614] | 69 | I +DUZ(2),BSDXP]"",$D(^AUPNPAT("D",BSDXP)) D S BSDXY=BSDXRET_$C(31) Q
|
---|
| 70 | . S BSDXIEN=0 F S BSDXIEN=$O(^AUPNPAT("D",BSDXP,BSDXIEN)) Q:'+BSDXIEN I $D(^AUPNPAT("D",BSDXP,BSDXIEN,DUZ(2))) D Q
|
---|
| 71 | . . Q:'$D(^DPT(BSDXIEN,0))
|
---|
| 72 | . . S BSDXDPT=$G(^DPT(BSDXIEN,0))
|
---|
| 73 | . . S BSDXZ=$P(BSDXDPT,U) ;NAME
|
---|
| 74 | . . S BSDXHRN=BSDXP ;CHART
|
---|
| 75 | . . I $D(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),$P(^(0),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
|
---|
| 76 | . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
|
---|
[867] | 77 | . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
|
---|
[614] | 78 | . . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
|
---|
| 79 | . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
|
---|
| 80 | . . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
|
---|
| 81 | . . S BSDXRET=BSDXRET_BSDXZ_$C(30)
|
---|
| 82 | . . Q
|
---|
| 83 | . Q
|
---|
[867] | 84 | ;
|
---|
| 85 | SSN ;SSN Lookup
|
---|
[614] | 86 | I (BSDXP?9N)!(BSDXP?3N1"-"2N1"-"4N),$D(^DPT("SSN",BSDXP)) D S BSDXY=BSDXRET_$C(31) Q
|
---|
| 87 | . S BSDXIEN=0 F S BSDXIEN=$O(^DPT("SSN",BSDXP,BSDXIEN)) Q:'+BSDXIEN D Q
|
---|
| 88 | . . Q:'$D(^DPT(BSDXIEN,0))
|
---|
| 89 | . . S BSDXDPT=$G(^DPT(BSDXIEN,0))
|
---|
| 90 | . . S BSDXZ=$P(BSDXDPT,U) ;NAME
|
---|
| 91 | . . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
|
---|
| 92 | . . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
|
---|
| 93 | . . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
|
---|
| 94 | . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
|
---|
[867] | 95 | . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
|
---|
[614] | 96 | . . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
|
---|
| 97 | . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
|
---|
| 98 | . . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
|
---|
| 99 | . . S BSDXRET=BSDXRET_BSDXZ_$C(30)
|
---|
| 100 | . . Q
|
---|
| 101 | . Q
|
---|
| 102 | ;
|
---|
| 103 | S BSDXFILE=9000001
|
---|
| 104 | S BSDXIENS=""
|
---|
| 105 | S BSDXFIELDS=".01"
|
---|
| 106 | S BSDXFLAGS="M"
|
---|
| 107 | S BSDXVALUE=BSDXP
|
---|
| 108 | S BSDXNUMBER=BSDXC
|
---|
| 109 | S BSDXINDEXES=""
|
---|
| 110 | S BSDXSCREEN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0))",1:"")
|
---|
| 111 | S BSDXIDEN=""
|
---|
| 112 | S BSDXTARG="BSDXRSLT"
|
---|
| 113 | S BSDXMSG=""
|
---|
| 114 | D FIND^DIC(BSDXFILE,BSDXIENS,BSDXFIELDS,BSDXFLAGS,BSDXVALUE,BSDXNUMBER,BSDXINDEXES,BSDXSCREEN,BSDXIDEN,BSDXTARG,BSDXMSG)
|
---|
| 115 | I '+$G(BSDXRSLT("DILIST",0)) S BSDXY=BSDXRET_$C(31) Q
|
---|
| 116 | N BSDXCNT S BSDXCNT=2
|
---|
| 117 | F BSDXX=1:1:$P(BSDXRSLT("DILIST",0),U) D
|
---|
| 118 | . S BSDXIEN=BSDXRSLT("DILIST",2,BSDXX)
|
---|
| 119 | . S BSDXZ=BSDXRSLT("DILIST","ID",BSDXX,.01) ;NAME
|
---|
| 120 | . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
|
---|
| 121 | . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
|
---|
| 122 | . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
|
---|
| 123 | . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
|
---|
| 124 | . S BSDXDPT=$G(^DPT(BSDXIEN,0))
|
---|
[867] | 125 | . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
|
---|
[614] | 126 | . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
|
---|
| 127 | . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
|
---|
| 128 | . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
|
---|
| 129 | . S $P(BSDXRET,$C(30),BSDXCNT)=BSDXZ
|
---|
| 130 | . S BSDXCNT=BSDXCNT+1
|
---|
| 131 | . Q
|
---|
| 132 | S BSDXY=BSDXRET_$C(30)_$C(31)
|
---|
| 133 | Q
|
---|
| 134 | ;
|
---|
| 135 | ERROR ;
|
---|
| 136 | D ERR("RPMS Error")
|
---|
| 137 | Q
|
---|
| 138 | ;
|
---|
| 139 | ERR(ERRNO) ;Error processing
|
---|
| 140 | S BSDXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$C(30)_"^^^^"_$C(30)_$C(31)
|
---|
| 141 | Q
|
---|