TMGHRPC2	;TMG/elh/Support Functions for TMG_CPRS ;10/20/09
	        ;;1.0;TMG-LIB;**1**;10/20/09;Build 3
	;
	;"Eddie Hagood
	;"GNU Lessor General Public License (LGPL) applies
	;"10/20/09
	;
	;"=======================================================================
	;" RPC -- Public Functions.
	;"=======================================================================
	;" <none>
	;"=======================================================================
	;"PRIVATE API FUNCTIONS
	;"=======================================================================
	;" ;
	;"=======================================================================
	;"Dependencies:
	;" ;
	;"=======================================================================
	;
LISTALL(Y,FROM,DIR)	    ; Return a bolus of patient names.  From is either Name or IEN^Name.
	  merge ^TMG("TMP","RPC","LISTALL^TMGHRPC2","FROM")=FROM
	  merge ^TMG("TMP","RPC","LISTALL^TMGHRPC2","DIR")=DIR
	  ;"IF $EXTRACT(FROM,1)="." DO INEXACT(.Y,FROM,.DIR) QUIT
	  IF $$WEDGE^TMGHRPC2(.Y,FROM,.DIR) QUIT
	  IF FROM'="" DO INEXACT(.Y,FROM,.DIR) QUIT
	  DO LISTALL^ORWPT(.Y,.FROM,.DIR)
	  QUIT
	  ;
WEDGE(OUT,FROM,DIR)	; 
	  ;"Purpose: Return a bolus of patient names, handling a leading date
	  ;"Input: OUT --  Out parameter, pass by reference.
	  ;"       FROM -- User specified string to search from.
	  ;"                If in format of a date, then handled here.  Otherwise
	  ;"                this function quits, and handling will occur elsewhere
	  ;".               Input can be either Name or IEN^Name (but later not
	  ;"                   handled here)
	  ;"                Example of Input: '10/1/67 Too~'
	  ;"                Note: CPRS decrements the terminal character of user
	  ;"                   input, and adds a ~   
	  ;"       DIR -- should be 1 or -1
	  ;"Results: 1 if handled, 0 if not handled.
	  ;"
	  NEW TMGCH,TMGTEMP,TMGTNAME,TMGSUBIEN,TMGB,TMGABORT
	  NEW I,IEN,CNT,FROMIEN,TMGNAME,TMGA,TMGANAME,TMGRESULT
	  NEW %DT,X,Y
	  SET CNT=44,I=0,TMGABORT=0
	  SET DIR=$GET(DIR,1)
	  SET TMGRESULT=0  ;"Default to failure
	  SET TMGA=$PIECE(FROM," ",1)
	  SET TMGB=$PIECE(FROM," ",2)
	  IF $$ISPHONE(FROM) QUIT $$HANDLEPHONE(.OUT,.FROM,.DIR)
	  IF $$ISMONTH(TMGA) DO
	  . NEW YEAR SET YEAR=$P(FROM," ",3)
	  . IF (YEAR?2.4N) DO
	  . . SET TMGA=$PIECE(FROM," ",1,3)
	  . . SET TMGB=$PIECE(FROM," ",4)
	  . ELSE  DO
	  . . SET TMGA=$PIECE(FROM," ",1,2)
	  . . SET TMGB=$PIECE(FROM," ",3)
	  ELSE  DO  
	  . ;"Test for nN/nN/nnNN pattern
	  . IF '(TMGA?1.2N1(1"-",1"/")1.2N1(1"-",1"/")2.4E0.1"~") SET TMGABORT=1
	  IF TMGABORT GOTO WQ
	  SET TMGA=$TRANSLATE(TMGA,"~","")
	  IF (DIR=1),TMGB="" DO   ;"Reverse CPRS's inc/dec of terminal digit if isolated date
	  . SET TMGCH=$E(TMGA,$L(TMGA))
	  . SET TMGCH=$CHAR($ASCII(TMGCH)+DIR)
	  . SET TMGA=$E(TMGA,1,$L(TMGA)-1)_TMGCH
	  SET %DT="P" ;"Assume past dates
	  SET X=TMGA
	  DO ^%DT  ;"convert external date to FM Date
	  IF Y=-1 GOTO WQ
	  SET IEN=0 
	  ;"Gather ALL patients with specified DOB, so can be sorted alphabetically
	  FOR  SET IEN=$ORDER(^DPT("ADOB",Y,IEN)) QUIT:'IEN  DO  
	  . SET TMGNAME=$P($G(^DPT(IEN,0)),U,1) ; Get zero node name.
	  . NEW TEMP SET TEMP=TMGA_" "_TMGNAME
	  . SET TMGTEMP(TEMP,IEN_U_TEMP_U_U_U_U_TEMP)=""
	  . SET TMGSUBIEN=0
	  . FOR  SET TMGSUBIEN=$O(^DPT(IEN,.01,TMGSUBIEN)) QUIT:TMGSUBIEN=""  DO
	  . . SET TMGANAME=$P($G(^DPT(IEN,.01,TMGSUBIEN,0)),U,1)
	  . . NEW TEMP2 SET TEMP2=TMGA_" "_TMGANAME
	  . . SET TMGTEMP(TEMP2,IEN_U_TEMP2_U_U_U_U_TEMP)=""
	  ;
	  KILL OUT	
	  SET TMGTNAME=TMGA_" "_$$UP^XLFSTR($TRANSLATE(TMGB,"~",""))
	  ;"Get sublist of patients starting at specified last name etc.
	  FOR  SET TMGTNAME=$ORDER(TMGTEMP(TMGTNAME),DIR) QUIT:TMGTNAME=""  DO  QUIT:I=CNT
	  . NEW ENTRY SET ENTRY=""
	  . FOR  SET ENTRY=$O(TMGTEMP(TMGTNAME,ENTRY),DIR) QUIT:ENTRY=""  DO  QUIT:I=CNT
	  . . SET I=I+1
	  . . SET OUT(I)=ENTRY
	  SET TMGRESULT=1
	  GOTO WQ
	  ;
WQ	QUIT TMGRESULT
	  ;
ISMONTH(S)	
	  ;"Purpose: to determine if S is a string specifying a month.
	  ;"Input: S -- the string to test.  It is altered, so don't pass by reference
	  ;"Results: 1 if is a month name, or 0 if not.
	  SET S=$$UP^XLFSTR(S)
	  SET S=$TRANSLATE(S,".","")
	  IF S="JANUARY"!(S="JAN") QUIT 1
	  IF S="FEBRUARY"!(S="FEB") QUIT 1
	  IF S="MARCH"!(S="MAR") QUIT 1
	  IF S="APRIL"!(S="APR") QUIT 1
	  IF S="MAY" QUIT 1
	  IF S="JUNE"!(S="JUN") QUIT 1
	  IF S="JULY"!(S="JUL") QUIT 1
	  IF S="AUGUST"!(S="AUG") QUIT 1
	  IF S="SEPTEMBER"!(S="SEP")!(S="SEPT") QUIT 1
	  IF S="OCTOBER"!(S="OCT") QUIT 1
	  IF S="NOVEMBER"!(S="NOV") QUIT 1
	  IF S="DECEMBER"!(S="DEC") QUIT 1
	  QUIT 0      
	;
ISPHONE(S)	
	  ;"Purpose: to determine is S is a phone number.
	  ;"Input: S -- the string to test.
	  ;"Results: 1 if a phone number, or 0 if not.
	  IF (S?3N1(1"-",1" ")3N1(1"-",1" ")1.4N.E) QUIT 1
	  ;IF (S?3N1(1"-",1" ")3.4N.E) QUIT 1
	  IF $EXTRACT(S,1)="(" QUIT 1
	  QUIT 0
	;
INEXACT(OUT,FROM,DIR)	
	  ;"Purpose: To perform an inexact, old-style Fileman lookup on user input
	  ;"Input: OUT --  Out parameter, pass by reference.
	  ;"       FROM -- User specified string to search from.
	  ;".               Input can be either Name or IEN^Name
	  ;"                Example of Input: '.Smit,Joh~'
	  ;"                Note: CPRS decrements the terminal character of user
	  ;"                   input, and adds a ~   
	  ;"       DIR -- should be 1 or -1
	  ;"Results: NONE
	  ;
	  NEW I,IEN,CNT,FROMIEN
	  SET CNT=44,I=0,FROMIEN=0
	  SET DIR=$GET(DIR,1)
	  NEW TMGCH,TMGTRIM SET TMGTRIM=""
	  ;"Trim any leading '.' or ' '
	  FOR  SET TMGCH=$EXTRACT(FROM,1) QUIT:(". "'[TMGCH)  DO
	  . SET TMGTRIM=TMGTRIM_$EXTRACT(FROM,1)
	  . SET FROM=$EXTRACT(FROM,2,999)
	  IF $PIECE(FROM,U,2)'="" DO
	  . SET FROM=$PIECE(FROM,U,2)
	  . SET FROMIEN=$PIECE(FROM,U,1)
	  NEW TMGSRCH SET TMGSRCH=$TRANSLATE(FROM,"~","")
	  NEW TMGSRFROM SET TMGSRFROM=""
	  IF TMGSRCH[" -- " DO
	  . SET TMGSRFROM=$PIECE(TMGSRCH," -- ",2)
	  . SET TMGSRCH=$PIECE(TMGSRCH," -- ",1)
	  IF (DIR=1),(TMGSRFROM="") DO   ;"Reverse CPRS's inc/dec of terminal digit
	  . SET TMGCH=$EXTRACT(TMGSRCH,$LENGTH(TMGSRCH))
	  . SET TMGCH=$CHAR($ASCII(TMGCH)+DIR)
	  . SET TMGSRCH=$EXTRACT(TMGSRCH,1,$LENGTH(TMGSRCH)-1)_TMGCH
	  NEW TMGOUT,TMGMSG
	  DO FIND^DIC(2,,"@;.01","PBC",TMGSRCH,"*",,,,"TMGOUT","TMGMSG")
	  KILL OUT
	  IF +TMGOUT("DILIST",0)'>0 QUIT  ;"No matches found.
	  ;   
	  ;"Gather ALL matching patients so can be sorted alphabetically
	  NEW TMGBYIEN,TMGTEMP
	  NEW TMGIDX SET TMGIDX=0
	  FOR  SET TMGIDX=$ORDER(TMGOUT("DILIST",TMGIDX)) QUIT:(TMGIDX="")  DO  
	  . SET TMGNAME=$PIECE($GET(TMGOUT("DILIST",TMGIDX,0)),U,2) 
	  . SET IEN=+$PIECE($GET(TMGOUT("DILIST",TMGIDX,0)),U,1) 
	  . NEW TEMP SET TEMP=TMGTRIM_TMGSRCH_" -- "_TMGNAME
	  . SET TMGTEMP(TEMP,IEN_U_TEMP_U_U_U_U_TEMP)=""
	  . IF FROMIEN>0 SET TMGBYIEN(IEN)=IEN_U_TEMP_U_U_U_U_TEM
	  ;
	  KILL OUT
	  IF $DATA(TMGBYIEN) DO
	  . SET IEN=FROMIEN-DIR
	  . FOR  SET IEN=$ORDER(TMGBYIEN(IEN),DIR) QUIT:(+IEN'>0)!(I=CNT)  DO
	  . . SET I=I+1
	  . . SET OUT(I)=$GET(TMGBYIEN(IEN))
	  ELSE  DO
	  . SET TMGTNAME=TMGTRIM_TMGSRCH_" -- "_TMGSRFROM
	  . FOR  SET TMGTNAME=$ORDER(TMGTEMP(TMGTNAME),DIR) QUIT:TMGTNAME=""  DO  QUIT:I=CNT
	  . . NEW ENTRY SET ENTRY=""
	  . . FOR  SET ENTRY=$ORDER(TMGTEMP(TMGTNAME,ENTRY),DIR) QUIT:ENTRY=""  DO  QUIT:I=CNT
	  . . . SET I=I+1
	  . . . SET OUT(I)=ENTRY
	  QUIT
	; 
HANDLEPHONE(OUT,FROM,DIR)	
	  ;"PURPOSE: To handle patient lookup by telephone
	  ;"Gather ALL patients with specified DOB, so can be sorted alphabetically
	  ;"Results: 1 if handled, 0 if not handled.
	  NEW TEMP1,TEMP2,TEMP3,TEMPNUM,IEN,TMGNAME,TMGTNAME,TMGCH
	  SET FROM=$TRANSLATE(FROM,"~","")
	  IF (DIR=1) DO   ;"Reverse CPRS's inc/dec of terminal digit if isolated date
	  . SET TMGCH=$E(FROM,$L(FROM))
	  . SET TMGCH=$CHAR($ASCII(TMGCH)+DIR)
	  . SET FROM=$E(FROM,1,$L(FROM)-1)_TMGCH
	  SET TEMPNUM=$TR(FROM,"(")
	  SET TEMPNUM=$TR(TEMPNUM," ")
	  SET TEMPNUM=$TR(TEMPNUM,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%^&*)-_=+[]{}<>,./?:;'\|")
	  SET TEMP1=$EXTRACT(TEMPNUM,1,3)
	  SET TEMP2=$EXTRACT(TEMPNUM,4,6)
	  SET TEMP3=$EXTRACT(TEMPNUM,7,99)
	  ;
	  NEW TMGIDX
	  FOR TMGIDX="AZVWVOE","ATMGPHONEWORK","ATMGPHONETEMP","ATMGPHONECELL"  DO
	  . SET TEMPNUM=TEMP1_TEMP2_TEMP3
	  . DO DOLOOKUP(.TMGTEMP,TMGIDX,TEMPNUM,FROM)
	  . SET TEMPNUM=TEMP1_" "_TEMP2_" "_TEMP3
	  . DO DOLOOKUP(.TMGTEMP,TMGIDX,TEMPNUM,FROM)
	  . SET TEMPNUM=TEMP1_" "_TEMP2_TEMP3
	  . DO DOLOOKUP(.TMGTEMP,TMGIDX,TEMPNUM,FROM)
	  . SET TEMPNUM=TEMP1_TEMP2_" "_TEMP3
	  . DO DOLOOKUP(.TMGTEMP,TMGIDX,TEMPNUM,FROM)
	  ;
	  KILL OUT
	  SET TMGTNAME=FROM_" "_$$UP^XLFSTR($TRANSLATE(FROM,"~",""))
	  ;"Get sublist of patients starting at specified last name etc.
	  FOR  SET TMGTNAME=$ORDER(TMGTEMP(TMGTNAME),DIR) QUIT:TMGTNAME=""  DO  QUIT:I=CNT
	  . NEW ENTRY SET ENTRY=""
	  . FOR  SET ENTRY=$O(TMGTEMP(TMGTNAME,ENTRY),DIR) QUIT:ENTRY=""  DO  QUIT:I=CNT
	  . . SET I=I+1
	  . . SET OUT(I)=ENTRY
	  QUIT 1
	;
DOLOOKUP(TMGTEMP,INDEX,ITEM,FROM)	
	  NEW TMGNAME,IEN
	  SET IEN=0
	  FOR  SET IEN=$ORDER(^DPT(INDEX,ITEM,IEN)) QUIT:'IEN  DO
	  . SET TMGNAME=$P($G(^DPT(IEN,0)),U,1) ; Get zero node name.
	  . NEW TEMP SET TEMP=FROM_" "_TMGNAME
	  . SET TMGTEMP(TEMP,IEN_U_TEMP_U_U_U_U_TEMP)=""
	  . SET TMGSUBIEN=0
	  QUIT
FIXINDEX	;
	 ;Check date of last run
	 ;if < 5 mins exit
	 ;loop through entry in Index
	 ;check entry for proper format
	 ;if improper format, then have fileman store new properly formatted number
	 ;store date of last run
	;
SETRPC(TMGMODULE)	;
	  ;"Purpose: Set module for RPC call.
	  IF $GET(TMGMODULE)="" QUIT
	  NEW TMGDATA,TMGMSG
	  SET DIC(0)="B"
	  SET DIC=8994
	  SET X="ORWPT LIST ALL"
	  DO ^DIC
	  IF Y=-1 QUIT
	  SET TMGDATA(8994,$P(Y,U,1)_",",".03")=TMGMODULE
	  DO FILE^DIE("K","TMGDATA","TMGMSG")
	  QUIT
	;
INSTWEDG	;
	  ;"Purpose: ROUTES RPC FOR CPRS PATIENT LOOKUP FROM ORWPT TO TMGHRPC2, IF IT EXISTS
	  DO SETRPC("TMGHRPC2") ;
	  QUIT
	;
DELWEDG	;
	  ;"Purpose: ROUTES RPC FOR CPRS PATIENT LOOKUP FROM ORWPT TO TMGHRPC2, IF IT EXISTS
	  DO SETRPC("ORWPT") ;
	  QUIT