| 1 | TMGHRPC2 ;TMG/elh/Support Functions for TMG_CPRS ;10/20/09
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;10/20/09;Build 3
|
|---|
| 3 | ;
|
|---|
| 4 | ;"Eddie Hagood
|
|---|
| 5 | ;"GNU Lessor General Public License (LGPL) applies
|
|---|
| 6 | ;"10/20/09
|
|---|
| 7 | ;
|
|---|
| 8 | ;"=======================================================================
|
|---|
| 9 | ;" RPC -- Public Functions.
|
|---|
| 10 | ;"=======================================================================
|
|---|
| 11 | ;" <none>
|
|---|
| 12 | ;"=======================================================================
|
|---|
| 13 | ;"PRIVATE API FUNCTIONS
|
|---|
| 14 | ;"=======================================================================
|
|---|
| 15 | ;" ;
|
|---|
| 16 | ;"=======================================================================
|
|---|
| 17 | ;"Dependencies:
|
|---|
| 18 | ;" ;
|
|---|
| 19 | ;"=======================================================================
|
|---|
| 20 | ;
|
|---|
| 21 | LISTALL(Y,FROM,DIR) ; Return a bolus of patient names. From is either Name or IEN^Name.
|
|---|
| 22 | merge ^TMG("TMP","RPC","LISTALL^TMGHRPC2","FROM")=FROM
|
|---|
| 23 | merge ^TMG("TMP","RPC","LISTALL^TMGHRPC2","DIR")=DIR
|
|---|
| 24 | ;"IF $EXTRACT(FROM,1)="." DO INEXACT(.Y,FROM,.DIR) QUIT
|
|---|
| 25 | IF $$WEDGE^TMGHRPC2(.Y,FROM,.DIR) QUIT
|
|---|
| 26 | IF FROM'="" DO INEXACT(.Y,FROM,.DIR) QUIT
|
|---|
| 27 | DO LISTALL^ORWPT(.Y,.FROM,.DIR)
|
|---|
| 28 | QUIT
|
|---|
| 29 | ;
|
|---|
| 30 | WEDGE(OUT,FROM,DIR) ;
|
|---|
| 31 | ;"Purpose: Return a bolus of patient names, handling a leading date
|
|---|
| 32 | ;"Input: OUT -- Out parameter, pass by reference.
|
|---|
| 33 | ;" FROM -- User specified string to search from.
|
|---|
| 34 | ;" If in format of a date, then handled here. Otherwise
|
|---|
| 35 | ;" this function quits, and handling will occur elsewhere
|
|---|
| 36 | ;". Input can be either Name or IEN^Name (but later not
|
|---|
| 37 | ;" handled here)
|
|---|
| 38 | ;" Example of Input: '10/1/67 Too~'
|
|---|
| 39 | ;" Note: CPRS decrements the terminal character of user
|
|---|
| 40 | ;" input, and adds a ~
|
|---|
| 41 | ;" DIR -- should be 1 or -1
|
|---|
| 42 | ;"Results: 1 if handled, 0 if not handled.
|
|---|
| 43 | ;"
|
|---|
| 44 | NEW TMGCH,TMGTEMP,TMGTNAME,TMGSUBIEN,TMGB,TMGABORT
|
|---|
| 45 | NEW I,IEN,CNT,FROMIEN,TMGNAME,TMGA,TMGANAME,TMGRESULT
|
|---|
| 46 | NEW %DT,X,Y
|
|---|
| 47 | SET CNT=44,I=0,TMGABORT=0
|
|---|
| 48 | SET DIR=$GET(DIR,1)
|
|---|
| 49 | SET TMGRESULT=0 ;"Default to failure
|
|---|
| 50 | SET TMGA=$PIECE(FROM," ",1)
|
|---|
| 51 | SET TMGB=$PIECE(FROM," ",2)
|
|---|
| 52 | IF $$ISPHONE(FROM) QUIT $$HANDLEPHONE(.OUT,.FROM,.DIR)
|
|---|
| 53 | IF $$ISMONTH(TMGA) DO
|
|---|
| 54 | . NEW YEAR SET YEAR=$P(FROM," ",3)
|
|---|
| 55 | . IF (YEAR?2.4N) DO
|
|---|
| 56 | . . SET TMGA=$PIECE(FROM," ",1,3)
|
|---|
| 57 | . . SET TMGB=$PIECE(FROM," ",4)
|
|---|
| 58 | . ELSE DO
|
|---|
| 59 | . . SET TMGA=$PIECE(FROM," ",1,2)
|
|---|
| 60 | . . SET TMGB=$PIECE(FROM," ",3)
|
|---|
| 61 | ELSE DO
|
|---|
| 62 | . ;"Test for nN/nN/nnNN pattern
|
|---|
| 63 | . IF '(TMGA?1.2N1(1"-",1"/")1.2N1(1"-",1"/")2.4E0.1"~") SET TMGABORT=1
|
|---|
| 64 | IF TMGABORT GOTO WQ
|
|---|
| 65 | SET TMGA=$TRANSLATE(TMGA,"~","")
|
|---|
| 66 | IF (DIR=1),TMGB="" DO ;"Reverse CPRS's inc/dec of terminal digit if isolated date
|
|---|
| 67 | . SET TMGCH=$E(TMGA,$L(TMGA))
|
|---|
| 68 | . SET TMGCH=$CHAR($ASCII(TMGCH)+DIR)
|
|---|
| 69 | . SET TMGA=$E(TMGA,1,$L(TMGA)-1)_TMGCH
|
|---|
| 70 | SET %DT="P" ;"Assume past dates
|
|---|
| 71 | SET X=TMGA
|
|---|
| 72 | DO ^%DT ;"convert external date to FM Date
|
|---|
| 73 | IF Y=-1 GOTO WQ
|
|---|
| 74 | SET IEN=0
|
|---|
| 75 | ;"Gather ALL patients with specified DOB, so can be sorted alphabetically
|
|---|
| 76 | FOR SET IEN=$ORDER(^DPT("ADOB",Y,IEN)) QUIT:'IEN DO
|
|---|
| 77 | . SET TMGNAME=$P($G(^DPT(IEN,0)),U,1) ; Get zero node name.
|
|---|
| 78 | . NEW TEMP SET TEMP=TMGA_" "_TMGNAME
|
|---|
| 79 | . SET TMGTEMP(TEMP,IEN_U_TEMP_U_U_U_U_TEMP)=""
|
|---|
| 80 | . SET TMGSUBIEN=0
|
|---|
| 81 | . FOR SET TMGSUBIEN=$O(^DPT(IEN,.01,TMGSUBIEN)) QUIT:TMGSUBIEN="" DO
|
|---|
| 82 | . . SET TMGANAME=$P($G(^DPT(IEN,.01,TMGSUBIEN,0)),U,1)
|
|---|
| 83 | . . NEW TEMP2 SET TEMP2=TMGA_" "_TMGANAME
|
|---|
| 84 | . . SET TMGTEMP(TEMP2,IEN_U_TEMP2_U_U_U_U_TEMP)=""
|
|---|
| 85 | ;
|
|---|
| 86 | KILL OUT
|
|---|
| 87 | SET TMGTNAME=TMGA_" "_$$UP^XLFSTR($TRANSLATE(TMGB,"~",""))
|
|---|
| 88 | ;"Get sublist of patients starting at specified last name etc.
|
|---|
| 89 | FOR SET TMGTNAME=$ORDER(TMGTEMP(TMGTNAME),DIR) QUIT:TMGTNAME="" DO QUIT:I=CNT
|
|---|
| 90 | . NEW ENTRY SET ENTRY=""
|
|---|
| 91 | . FOR SET ENTRY=$O(TMGTEMP(TMGTNAME,ENTRY),DIR) QUIT:ENTRY="" DO QUIT:I=CNT
|
|---|
| 92 | . . SET I=I+1
|
|---|
| 93 | . . SET OUT(I)=ENTRY
|
|---|
| 94 | SET TMGRESULT=1
|
|---|
| 95 | GOTO WQ
|
|---|
| 96 | ;
|
|---|
| 97 | WQ QUIT TMGRESULT
|
|---|
| 98 | ;
|
|---|
| 99 | ISMONTH(S)
|
|---|
| 100 | ;"Purpose: to determine if S is a string specifying a month.
|
|---|
| 101 | ;"Input: S -- the string to test. It is altered, so don't pass by reference
|
|---|
| 102 | ;"Results: 1 if is a month name, or 0 if not.
|
|---|
| 103 | SET S=$$UP^XLFSTR(S)
|
|---|
| 104 | SET S=$TRANSLATE(S,".","")
|
|---|
| 105 | IF S="JANUARY"!(S="JAN") QUIT 1
|
|---|
| 106 | IF S="FEBRUARY"!(S="FEB") QUIT 1
|
|---|
| 107 | IF S="MARCH"!(S="MAR") QUIT 1
|
|---|
| 108 | IF S="APRIL"!(S="APR") QUIT 1
|
|---|
| 109 | IF S="MAY" QUIT 1
|
|---|
| 110 | IF S="JUNE"!(S="JUN") QUIT 1
|
|---|
| 111 | IF S="JULY"!(S="JUL") QUIT 1
|
|---|
| 112 | IF S="AUGUST"!(S="AUG") QUIT 1
|
|---|
| 113 | IF S="SEPTEMBER"!(S="SEP")!(S="SEPT") QUIT 1
|
|---|
| 114 | IF S="OCTOBER"!(S="OCT") QUIT 1
|
|---|
| 115 | IF S="NOVEMBER"!(S="NOV") QUIT 1
|
|---|
| 116 | IF S="DECEMBER"!(S="DEC") QUIT 1
|
|---|
| 117 | QUIT 0
|
|---|
| 118 | ;
|
|---|
| 119 | ISPHONE(S)
|
|---|
| 120 | ;"Purpose: to determine is S is a phone number.
|
|---|
| 121 | ;"Input: S -- the string to test.
|
|---|
| 122 | ;"Results: 1 if a phone number, or 0 if not.
|
|---|
| 123 | IF (S?3N1(1"-",1" ")3N1(1"-",1" ")1.4N.E) QUIT 1
|
|---|
| 124 | ;IF (S?3N1(1"-",1" ")3.4N.E) QUIT 1
|
|---|
| 125 | IF $EXTRACT(S,1)="(" QUIT 1
|
|---|
| 126 | QUIT 0
|
|---|
| 127 | ;
|
|---|
| 128 | INEXACT(OUT,FROM,DIR)
|
|---|
| 129 | ;"Purpose: To perform an inexact, old-style Fileman lookup on user input
|
|---|
| 130 | ;"Input: OUT -- Out parameter, pass by reference.
|
|---|
| 131 | ;" FROM -- User specified string to search from.
|
|---|
| 132 | ;". Input can be either Name or IEN^Name
|
|---|
| 133 | ;" Example of Input: '.Smit,Joh~'
|
|---|
| 134 | ;" Note: CPRS decrements the terminal character of user
|
|---|
| 135 | ;" input, and adds a ~
|
|---|
| 136 | ;" DIR -- should be 1 or -1
|
|---|
| 137 | ;"Results: NONE
|
|---|
| 138 | ;
|
|---|
| 139 | NEW I,IEN,CNT,FROMIEN
|
|---|
| 140 | SET CNT=44,I=0,FROMIEN=0
|
|---|
| 141 | SET DIR=$GET(DIR,1)
|
|---|
| 142 | NEW TMGCH,TMGTRIM SET TMGTRIM=""
|
|---|
| 143 | ;"Trim any leading '.' or ' '
|
|---|
| 144 | FOR SET TMGCH=$EXTRACT(FROM,1) QUIT:(". "'[TMGCH) DO
|
|---|
| 145 | . SET TMGTRIM=TMGTRIM_$EXTRACT(FROM,1)
|
|---|
| 146 | . SET FROM=$EXTRACT(FROM,2,999)
|
|---|
| 147 | IF $PIECE(FROM,U,2)'="" DO
|
|---|
| 148 | . SET FROM=$PIECE(FROM,U,2)
|
|---|
| 149 | . SET FROMIEN=$PIECE(FROM,U,1)
|
|---|
| 150 | NEW TMGSRCH SET TMGSRCH=$TRANSLATE(FROM,"~","")
|
|---|
| 151 | NEW TMGSRFROM SET TMGSRFROM=""
|
|---|
| 152 | IF TMGSRCH[" -- " DO
|
|---|
| 153 | . SET TMGSRFROM=$PIECE(TMGSRCH," -- ",2)
|
|---|
| 154 | . SET TMGSRCH=$PIECE(TMGSRCH," -- ",1)
|
|---|
| 155 | IF (DIR=1),(TMGSRFROM="") DO ;"Reverse CPRS's inc/dec of terminal digit
|
|---|
| 156 | . SET TMGCH=$EXTRACT(TMGSRCH,$LENGTH(TMGSRCH))
|
|---|
| 157 | . SET TMGCH=$CHAR($ASCII(TMGCH)+DIR)
|
|---|
| 158 | . SET TMGSRCH=$EXTRACT(TMGSRCH,1,$LENGTH(TMGSRCH)-1)_TMGCH
|
|---|
| 159 | NEW TMGOUT,TMGMSG
|
|---|
| 160 | DO FIND^DIC(2,,"@;.01","PBC",TMGSRCH,"*",,,,"TMGOUT","TMGMSG")
|
|---|
| 161 | KILL OUT
|
|---|
| 162 | IF +TMGOUT("DILIST",0)'>0 QUIT ;"No matches found.
|
|---|
| 163 | ;
|
|---|
| 164 | ;"Gather ALL matching patients so can be sorted alphabetically
|
|---|
| 165 | NEW TMGBYIEN,TMGTEMP
|
|---|
| 166 | NEW TMGIDX SET TMGIDX=0
|
|---|
| 167 | FOR SET TMGIDX=$ORDER(TMGOUT("DILIST",TMGIDX)) QUIT:(TMGIDX="") DO
|
|---|
| 168 | . SET TMGNAME=$PIECE($GET(TMGOUT("DILIST",TMGIDX,0)),U,2)
|
|---|
| 169 | . SET IEN=+$PIECE($GET(TMGOUT("DILIST",TMGIDX,0)),U,1)
|
|---|
| 170 | . NEW TEMP SET TEMP=TMGTRIM_TMGSRCH_" -- "_TMGNAME
|
|---|
| 171 | . SET TMGTEMP(TEMP,IEN_U_TEMP_U_U_U_U_TEMP)=""
|
|---|
| 172 | . IF FROMIEN>0 SET TMGBYIEN(IEN)=IEN_U_TEMP_U_U_U_U_TEM
|
|---|
| 173 | ;
|
|---|
| 174 | KILL OUT
|
|---|
| 175 | IF $DATA(TMGBYIEN) DO
|
|---|
| 176 | . SET IEN=FROMIEN-DIR
|
|---|
| 177 | . FOR SET IEN=$ORDER(TMGBYIEN(IEN),DIR) QUIT:(+IEN'>0)!(I=CNT) DO
|
|---|
| 178 | . . SET I=I+1
|
|---|
| 179 | . . SET OUT(I)=$GET(TMGBYIEN(IEN))
|
|---|
| 180 | ELSE DO
|
|---|
| 181 | . SET TMGTNAME=TMGTRIM_TMGSRCH_" -- "_TMGSRFROM
|
|---|
| 182 | . FOR SET TMGTNAME=$ORDER(TMGTEMP(TMGTNAME),DIR) QUIT:TMGTNAME="" DO QUIT:I=CNT
|
|---|
| 183 | . . NEW ENTRY SET ENTRY=""
|
|---|
| 184 | . . FOR SET ENTRY=$ORDER(TMGTEMP(TMGTNAME,ENTRY),DIR) QUIT:ENTRY="" DO QUIT:I=CNT
|
|---|
| 185 | . . . SET I=I+1
|
|---|
| 186 | . . . SET OUT(I)=ENTRY
|
|---|
| 187 | QUIT
|
|---|
| 188 | ;
|
|---|
| 189 | HANDLEPHONE(OUT,FROM,DIR)
|
|---|
| 190 | ;"PURPOSE: To handle patient lookup by telephone
|
|---|
| 191 | ;"Gather ALL patients with specified DOB, so can be sorted alphabetically
|
|---|
| 192 | ;"Results: 1 if handled, 0 if not handled.
|
|---|
| 193 | NEW TEMP1,TEMP2,TEMP3,TEMPNUM,IEN,TMGNAME,TMGTNAME,TMGCH
|
|---|
| 194 | SET FROM=$TRANSLATE(FROM,"~","")
|
|---|
| 195 | IF (DIR=1) DO ;"Reverse CPRS's inc/dec of terminal digit if isolated date
|
|---|
| 196 | . SET TMGCH=$E(FROM,$L(FROM))
|
|---|
| 197 | . SET TMGCH=$CHAR($ASCII(TMGCH)+DIR)
|
|---|
| 198 | . SET FROM=$E(FROM,1,$L(FROM)-1)_TMGCH
|
|---|
| 199 | SET TEMPNUM=$TR(FROM,"(")
|
|---|
| 200 | SET TEMPNUM=$TR(TEMPNUM," ")
|
|---|
| 201 | SET TEMPNUM=$TR(TEMPNUM,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%^&*)-_=+[]{}<>,./?:;'\|")
|
|---|
| 202 | SET TEMP1=$EXTRACT(TEMPNUM,1,3)
|
|---|
| 203 | SET TEMP2=$EXTRACT(TEMPNUM,4,6)
|
|---|
| 204 | SET TEMP3=$EXTRACT(TEMPNUM,7,99)
|
|---|
| 205 | ;
|
|---|
| 206 | NEW TMGIDX
|
|---|
| 207 | FOR TMGIDX="AZVWVOE","ATMGPHONEWORK","ATMGPHONETEMP","ATMGPHONECELL" DO
|
|---|
| 208 | . SET TEMPNUM=TEMP1_TEMP2_TEMP3
|
|---|
| 209 | . DO DOLOOKUP(.TMGTEMP,TMGIDX,TEMPNUM,FROM)
|
|---|
| 210 | . SET TEMPNUM=TEMP1_" "_TEMP2_" "_TEMP3
|
|---|
| 211 | . DO DOLOOKUP(.TMGTEMP,TMGIDX,TEMPNUM,FROM)
|
|---|
| 212 | . SET TEMPNUM=TEMP1_" "_TEMP2_TEMP3
|
|---|
| 213 | . DO DOLOOKUP(.TMGTEMP,TMGIDX,TEMPNUM,FROM)
|
|---|
| 214 | . SET TEMPNUM=TEMP1_TEMP2_" "_TEMP3
|
|---|
| 215 | . DO DOLOOKUP(.TMGTEMP,TMGIDX,TEMPNUM,FROM)
|
|---|
| 216 | ;
|
|---|
| 217 | KILL OUT
|
|---|
| 218 | SET TMGTNAME=FROM_" "_$$UP^XLFSTR($TRANSLATE(FROM,"~",""))
|
|---|
| 219 | ;"Get sublist of patients starting at specified last name etc.
|
|---|
| 220 | FOR SET TMGTNAME=$ORDER(TMGTEMP(TMGTNAME),DIR) QUIT:TMGTNAME="" DO QUIT:I=CNT
|
|---|
| 221 | . NEW ENTRY SET ENTRY=""
|
|---|
| 222 | . FOR SET ENTRY=$O(TMGTEMP(TMGTNAME,ENTRY),DIR) QUIT:ENTRY="" DO QUIT:I=CNT
|
|---|
| 223 | . . SET I=I+1
|
|---|
| 224 | . . SET OUT(I)=ENTRY
|
|---|
| 225 | QUIT 1
|
|---|
| 226 | ;
|
|---|
| 227 | DOLOOKUP(TMGTEMP,INDEX,ITEM,FROM)
|
|---|
| 228 | NEW TMGNAME,IEN
|
|---|
| 229 | SET IEN=0
|
|---|
| 230 | FOR SET IEN=$ORDER(^DPT(INDEX,ITEM,IEN)) QUIT:'IEN DO
|
|---|
| 231 | . SET TMGNAME=$P($G(^DPT(IEN,0)),U,1) ; Get zero node name.
|
|---|
| 232 | . NEW TEMP SET TEMP=FROM_" "_TMGNAME
|
|---|
| 233 | . SET TMGTEMP(TEMP,IEN_U_TEMP_U_U_U_U_TEMP)=""
|
|---|
| 234 | . SET TMGSUBIEN=0
|
|---|
| 235 | QUIT
|
|---|
| 236 | FIXINDEX ;
|
|---|
| 237 | ;Check date of last run
|
|---|
| 238 | ;if < 5 mins exit
|
|---|
| 239 | ;loop through entry in Index
|
|---|
| 240 | ;check entry for proper format
|
|---|
| 241 | ;if improper format, then have fileman store new properly formatted number
|
|---|
| 242 | ;store date of last run
|
|---|
| 243 | ;
|
|---|
| 244 | SETRPC(TMGMODULE) ;
|
|---|
| 245 | ;"Purpose: Set module for RPC call.
|
|---|
| 246 | IF $GET(TMGMODULE)="" QUIT
|
|---|
| 247 | NEW TMGDATA,TMGMSG
|
|---|
| 248 | SET DIC(0)="B"
|
|---|
| 249 | SET DIC=8994
|
|---|
| 250 | SET X="ORWPT LIST ALL"
|
|---|
| 251 | DO ^DIC
|
|---|
| 252 | IF Y=-1 QUIT
|
|---|
| 253 | SET TMGDATA(8994,$P(Y,U,1)_",",".03")=TMGMODULE
|
|---|
| 254 | DO FILE^DIE("K","TMGDATA","TMGMSG")
|
|---|
| 255 | QUIT
|
|---|
| 256 | ;
|
|---|
| 257 | INSTWEDG ;
|
|---|
| 258 | ;"Purpose: ROUTES RPC FOR CPRS PATIENT LOOKUP FROM ORWPT TO TMGHRPC2, IF IT EXISTS
|
|---|
| 259 | DO SETRPC("TMGHRPC2") ;
|
|---|
| 260 | QUIT
|
|---|
| 261 | ;
|
|---|
| 262 | DELWEDG ;
|
|---|
| 263 | ;"Purpose: ROUTES RPC FOR CPRS PATIENT LOOKUP FROM ORWPT TO TMGHRPC2, IF IT EXISTS
|
|---|
| 264 | DO SETRPC("ORWPT") ;
|
|---|
| 265 | QUIT
|
|---|
| 266 |
|
|---|
