source: cprs/branches/tmg-cprs/Server_KIDS/TMG-CPRS-LOOKUP-1.0-2.KIDS

KIDS Distribution saved on Nov 06, 2009@17:51
This is Version 2 of the TMG CPRS LOOKUP
**KIDS**:TMG-CPRS-LOOKUP*1.0*2^

**INSTALL NAME**
TMG-CPRS-LOOKUP*1.0*2
"BLD",6143,0)
TMG-CPRS-LOOKUP*1.0*2^^0^3091106^n
"BLD",6143,1,0)
^^1^1^3091029^^
"BLD",6143,1,1,0)
Enhanced CPRS Patient Lookup (DOB, Partial Name)
"BLD",6143,4,0)
^9.64PA^2^1
"BLD",6143,4,2,0)
2
"BLD",6143,4,2,2,0)
^9.641^2^1
"BLD",6143,4,2,2,2,0)
PATIENT  (File-top level)
"BLD",6143,4,2,2,2,1,0)
^9.6411^.131^4
"BLD",6143,4,2,2,2,1,.1219,0)
TEMPORARY PHONE NUMBER
"BLD",6143,4,2,2,2,1,.131,0)
PHONE NUMBER [RESIDENCE]
"BLD",6143,4,2,2,2,1,.132,0)
PHONE NUMBER [WORK]
"BLD",6143,4,2,2,2,1,.134,0)
PHONE NUMBER [CELLULAR]
"BLD",6143,4,2,222)
y^y^p^^^^n^^n
"BLD",6143,4,2,224)

"BLD",6143,4,"APDD",2,2)

"BLD",6143,4,"APDD",2,2,.1219)

"BLD",6143,4,"APDD",2,2,.131)

"BLD",6143,4,"APDD",2,2,.132)

"BLD",6143,4,"APDD",2,2,.134)

"BLD",6143,4,"B",2,2)

"BLD",6143,6.3)
3
"BLD",6143,"INID")
^n
"BLD",6143,"INIT")
INSTWEDG^TMGHRPC2
"BLD",6143,"KRN",0)
^9.67PA^8989.52^19
"BLD",6143,"KRN",.4,0)
.4
"BLD",6143,"KRN",.401,0)
.401
"BLD",6143,"KRN",.402,0)
.402
"BLD",6143,"KRN",.403,0)
.403
"BLD",6143,"KRN",.5,0)
.5
"BLD",6143,"KRN",.84,0)
.84
"BLD",6143,"KRN",3.6,0)
3.6
"BLD",6143,"KRN",3.8,0)
3.8
"BLD",6143,"KRN",9.2,0)
9.2
"BLD",6143,"KRN",9.8,0)
9.8
"BLD",6143,"KRN",9.8,"NM",0)
^9.68A^1^1
"BLD",6143,"KRN",9.8,"NM",1,0)
TMGHRPC2^^0^B18190063
"BLD",6143,"KRN",9.8,"NM","B","TMGHRPC2",1)

"BLD",6143,"KRN",19,0)
19
"BLD",6143,"KRN",19.1,0)
19.1
"BLD",6143,"KRN",101,0)
101
"BLD",6143,"KRN",409.61,0)
409.61
"BLD",6143,"KRN",771,0)
771
"BLD",6143,"KRN",870,0)
870
"BLD",6143,"KRN",8989.51,0)
8989.51
"BLD",6143,"KRN",8989.52,0)
8989.52
"BLD",6143,"KRN",8994,0)
8994
"BLD",6143,"KRN","B",.4,.4)

"BLD",6143,"KRN","B",.401,.401)

"BLD",6143,"KRN","B",.402,.402)

"BLD",6143,"KRN","B",.403,.403)

"BLD",6143,"KRN","B",.5,.5)

"BLD",6143,"KRN","B",.84,.84)

"BLD",6143,"KRN","B",3.6,3.6)

"BLD",6143,"KRN","B",3.8,3.8)

"BLD",6143,"KRN","B",9.2,9.2)

"BLD",6143,"KRN","B",9.8,9.8)

"BLD",6143,"KRN","B",19,19)

"BLD",6143,"KRN","B",19.1,19.1)

"BLD",6143,"KRN","B",101,101)

"BLD",6143,"KRN","B",409.61,409.61)

"BLD",6143,"KRN","B",771,771)

"BLD",6143,"KRN","B",870,870)

"BLD",6143,"KRN","B",8989.51,8989.51)

"BLD",6143,"KRN","B",8989.52,8989.52)

"BLD",6143,"KRN","B",8994,8994)

"BLD",6143,"QUES",0)
^9.62^^
"FIA",2)
PATIENT
"FIA",2,0)
^DPT(
"FIA",2,0,0)
2I
"FIA",2,0,1)
y^y^p^^^^n^^n
"FIA",2,0,10)

"FIA",2,0,11)

"FIA",2,0,"RLRO")

"FIA",2,2)
1
"FIA",2,2,.1219)

"FIA",2,2,.131)

"FIA",2,2,.132)

"FIA",2,2,.134)

"INIT")
INSTWEDG^TMGHRPC2
"MBREQ")
0
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
YES
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

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

"^DD",2,2,.1219,1,0)
^.1
"^DD",2,2,.1219,1,22700,0)
2^ATMGPHONETEMP
"^DD",2,2,.1219,1,22700,1)
N % S %=$E($TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%^&*()-_=+[]{}<>,./?:;'\|"),1,30) S:%'="" ^DPT("ATMGPHONETEMP",%,DA)=""
"^DD",2,2,.1219,1,22700,2)
N % S %=$E($TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%^&*()-_=+[]{}<>,./?:;'\|"),1,30) K:%'="" ^DPT("ATMGPHONETEMP",%,DA)
"^DD",2,2,.1219,1,22700,"%D",0)
^^2^2^3091106^^
"^DD",2,2,.1219,1,22700,"%D",1,0)
Created by K. Toppenberg (TMG) for lookup
"^DD",2,2,.1219,1,22700,"%D",2,0)
based on temp phone number
"^DD",2,2,.1219,1,22700,"DT")
3091106
"^DD",2,2,.1219,3)
Enter the telephone number of the temporary address at which the patient is located [4-20 characters].
"^DD",2,2,.1219,20,0)
^.3LA^1^1
"^DD",2,2,.1219,20,1,0)
TAD
"^DD",2,2,.1219,21,0)
^^5^5^2861007^^
"^DD",2,2,.1219,21,1,0)
If the WANT TO ENTER A TEMPORARY ADDRESS prompt is answered YES
"^DD",2,2,.1219,21,2,0)
enter the telephone number at which the applicant can be
"^DD",2,2,.1219,21,3,0)
contacted [4-20 characters] during his/her absence from permanent
"^DD",2,2,.1219,21,4,0)
residence, otherwise nothing may be entered.  This field may not
"^DD",2,2,.1219,21,5,0)
be deleted as long as the need for a temporary address is indicated.
"^DD",2,2,.1219,"DT")
3091106
"^DD",2,2,.131,0)
PHONE NUMBER [RESIDENCE]^Fa^^.13;1^K:$L(X)>20!($L(X)<4) X
"^DD",2,2,.131,.1)

"^DD",2,2,.131,1,0)
^.1^^-1
"^DD",2,2,.131,1,1,0)
2^AENR131^MUMPS
"^DD",2,2,.131,1,1,1)
D EVENT^IVMPLOG(DA)
"^DD",2,2,.131,1,1,2)
D EVENT^IVMPLOG(DA)
"^DD",2,2,.131,1,1,3)
DO NOT DELETE
"^DD",2,2,.131,1,1,"%D",0)
^^2^2^2971007^^^
"^DD",2,2,.131,1,1,"%D",1,0)
This cross-reference is used to notify HEC of changes that may affect
"^DD",2,2,.131,1,1,"%D",2,0)
enrollment. 
"^DD",2,2,.131,1,1,"DT")
2971007
"^DD",2,2,.131,1,301,0)
2^IVM131^MUMPS
"^DD",2,2,.131,1,301,1)
S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
"^DD",2,2,.131,1,301,2)
S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
"^DD",2,2,.131,1,301,"%D",0)
^^5^5^2930605^
"^DD",2,2,.131,1,301,"%D",1,0)
This cross-reference will check the IVM PATIENT file to see if a change
"^DD",2,2,.131,1,301,"%D",2,0)
to this field will require transmission to the IVM Center.  If it does,
"^DD",2,2,.131,1,301,"%D",3,0)
the IVM PATIENT file entry's TRANSMISSION STATUS will be set to 0 and
"^DD",2,2,.131,1,301,"%D",4,0)
the nightly background job will transmit the updated information.
"^DD",2,2,.131,1,301,"DT")
2930605
"^DD",2,2,.131,1,991,0)
2^AVAFC131^MUMPS
"^DD",2,2,.131,1,991,1)
I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".131;" D AVAFC^VAFCDD01(DA)
"^DD",2,2,.131,1,991,2)
I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".131;" D AVAFC^VAFCDD01(DA)
"^DD",2,2,.131,1,991,"%D",0)
^^15^15^2990204^^^^
"^DD",2,2,.131,1,991,"%D",1,0)
This cross reference is used to remember that changes were made to the
"^DD",2,2,.131,1,991,"%D",2,0)
PATIENT file (#2) outside of the Registration process.  Execution of this
"^DD",2,2,.131,1,991,"%D",3,0)
cross reference will create an entry in the ADT/HL7 PIVOT file (#391.71)
"^DD",2,2,.131,1,991,"%D",4,0)
and mark it as requiring transmission of an HL7 ADT-A08 message.
"^DD",2,2,.131,1,991,"%D",5,0)
 
"^DD",2,2,.131,1,991,"%D",6,0)
The local variable VAFCFLG will be set to 1 if the cross reference is
"^DD",2,2,.131,1,991,"%D",7,0)
not executed because the change is being made from within the Registration
"^DD",2,2,.131,1,991,"%D",8,0)
process.
"^DD",2,2,.131,1,991,"%D",9,0)
 
"^DD",2,2,.131,1,991,"%D",10,0)
Execution of this cross reference can be prevented by setting the local
"^DD",2,2,.131,1,991,"%D",11,0)
variable VAFCA08 equal to 1.
"^DD",2,2,.131,1,991,"%D",12,0)
  
"^DD",2,2,.131,1,991,"%D",13,0)
The local variable VAFCF is used to identify the field edited.
"^DD",2,2,.131,1,991,"%D",14,0)
This data is stored in the FIELD(S) EDITED (#2.1) field in the 
"^DD",2,2,.131,1,991,"%D",15,0)
ADT/HL7 PIVOT file (#391.71).
"^DD",2,2,.131,1,991,"DT")
2970825
"^DD",2,2,.131,1,992,0)
2^ADGRU131^MUMPS
"^DD",2,2,.131,1,992,1)
D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
"^DD",2,2,.131,1,992,2)
D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
"^DD",2,2,.131,1,992,"%D",0)
^^9^9^2990920^
"^DD",2,2,.131,1,992,"%D",1,0)
This cross reference is used to remember that changes were made to a 
"^DD",2,2,.131,1,992,"%D",2,0)
monitored data field in the PATIENT File (#2) required for a vendor
"^DD",2,2,.131,1,992,"%D",3,0)
RAI/MDS COTS system.  Execution of this cross reference will create
"^DD",2,2,.131,1,992,"%D",4,0)
an entry in the ADT/HL7 PIVOT file (#391.71) and mark it as requiring
"^DD",2,2,.131,1,992,"%D",5,0)
transmission of an HL7 demographic A08 update message to the COTS
"^DD",2,2,.131,1,992,"%D",6,0)
interface.
"^DD",2,2,.131,1,992,"%D",7,0)
 
"^DD",2,2,.131,1,992,"%D",8,0)
The local variable DGRUGA08 will be set to 1 if the cross reference is
"^DD",2,2,.131,1,992,"%D",9,0)
not to be executed as part of a re-indexing.
"^DD",2,2,.131,1,992,"DT")
2990920
"^DD",2,2,.131,1,251000,0)
2^AZVWVOE^MUMPS
"^DD",2,2,.131,1,251000,1)
N % S %=$E($TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%^&*()-_=+[]{}<>,./?:;'\|"),1,30) S:%'="" ^DPT("AZVWVOE",%,DA)=""
"^DD",2,2,.131,1,251000,2)
N % S %=$E($TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%^&*()-_=+[]{}<>,./?:;'\|"),1,30) K:%'="" ^DPT("AZVWVOE",%,DA)
"^DD",2,2,.131,1,251000,"%D",0)
^^1^1^3061220^
"^DD",2,2,.131,1,251000,"%D",1,0)
CREATED BY TIMSON FOR PATIENT LOOKUP BY PHONE NUMBER
"^DD",2,2,.131,1,251000,"DT")
3061220
"^DD",2,2,.131,3)
Enter the patients home telephone number [4-20 characters].
"^DD",2,2,.131,20,0)
^.3LA^1^1
"^DD",2,2,.131,20,1,0)
DEMOG
"^DD",2,2,.131,21,0)
^^2^2^2861007^
"^DD",2,2,.131,21,1,0)
Enter the telephone number [4-20 characters] to this applicant's
"^DD",2,2,.131,21,2,0)
place of residence.
"^DD",2,2,.131,"AUDIT")
y
"^DD",2,2,.131,"DT")
2980520
"^DD",2,2,.132,0)
PHONE NUMBER [WORK]^Fa^^.13;2^K:$L(X)>20!($L(X)<4) X
"^DD",2,2,.132,.1)
OFFICE PHONE
"^DD",2,2,.132,1,0)
^.1
"^DD",2,2,.132,1,1,0)
2^AENR132^MUMPS
"^DD",2,2,.132,1,1,1)
D EVENT^IVMPLOG(DA)
"^DD",2,2,.132,1,1,2)
D EVENT^IVMPLOG(DA)
"^DD",2,2,.132,1,1,3)
DO NOT DELETE
"^DD",2,2,.132,1,1,"%D",0)
^^2^2^2971007^^^
"^DD",2,2,.132,1,1,"%D",1,0)
This cross-reference is used to notify HEC of changes that may affect
"^DD",2,2,.132,1,1,"%D",2,0)
enrollment. 
"^DD",2,2,.132,1,1,"DT")
2971007
"^DD",2,2,.132,1,301,0)
2^IVM132^MUMPS
"^DD",2,2,.132,1,301,1)
S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
"^DD",2,2,.132,1,301,2)
S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
"^DD",2,2,.132,1,301,"%D",0)
^^5^5^2930605^
"^DD",2,2,.132,1,301,"%D",1,0)
This cross-reference will check the IVM PATIENT file to see if a change
"^DD",2,2,.132,1,301,"%D",2,0)
to this field will require transmission to the IVM Center.  If it does,
"^DD",2,2,.132,1,301,"%D",3,0)
the IVM PATIENT file entry's TRANSMISSION STATUS will be set to 0 and
"^DD",2,2,.132,1,301,"%D",4,0)
the nightly background job will transmit the updated information.
"^DD",2,2,.132,1,301,"DT")
2930605
"^DD",2,2,.132,1,991,0)
2^AVAFC132^MUMPS
"^DD",2,2,.132,1,991,1)
I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".132;" D AVAFC^VAFCDD01(DA)
"^DD",2,2,.132,1,991,2)
I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".132;" D AVAFC^VAFCDD01(DA)
"^DD",2,2,.132,1,991,"%D",0)
^^15^15^2990204^^^^
"^DD",2,2,.132,1,991,"%D",1,0)
This cross reference is used to remember that changes were made to the
"^DD",2,2,.132,1,991,"%D",2,0)
PATIENT file (#2) outside of the Registration process.  Execution of this
"^DD",2,2,.132,1,991,"%D",3,0)
cross reference will create an entry in the ADT/HL7 PIVOT file (#391.71)
"^DD",2,2,.132,1,991,"%D",4,0)
and mark it as requiring transmission of an HL7 ADT-A08 message.
"^DD",2,2,.132,1,991,"%D",5,0)
 
"^DD",2,2,.132,1,991,"%D",6,0)
The local variable VAFCFLG will be set to 1 if the cross reference is
"^DD",2,2,.132,1,991,"%D",7,0)
not executed because the change is being made from within the Registration
"^DD",2,2,.132,1,991,"%D",8,0)
process.
"^DD",2,2,.132,1,991,"%D",9,0)
 
"^DD",2,2,.132,1,991,"%D",10,0)
Execution of this cross reference can be prevented by setting the local
"^DD",2,2,.132,1,991,"%D",11,0)
variable VAFCA08 equal to 1.
"^DD",2,2,.132,1,991,"%D",12,0)
  
"^DD",2,2,.132,1,991,"%D",13,0)
The local variable VAFCF is used to identify the field edited.
"^DD",2,2,.132,1,991,"%D",14,0)
This data is stored in the FIELD(S) EDITED (#2.1) field in the 
"^DD",2,2,.132,1,991,"%D",15,0)
ADT/HL7 PIVOT file (#391.71).
"^DD",2,2,.132,1,991,"DT")
2970825
"^DD",2,2,.132,1,992,0)
2^ADGRU132^MUMPS
"^DD",2,2,.132,1,992,1)
D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
"^DD",2,2,.132,1,992,2)
D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
"^DD",2,2,.132,1,992,"%D",0)
^^9^9^2990920^
"^DD",2,2,.132,1,992,"%D",1,0)
This cross reference is used to remember that changes were made to a 
"^DD",2,2,.132,1,992,"%D",2,0)
monitored data field in the PATIENT File (#2) required for a vendor
"^DD",2,2,.132,1,992,"%D",3,0)
RAI/MDS COTS system.  Execution of this cross reference will create
"^DD",2,2,.132,1,992,"%D",4,0)
an entry in the ADT/HL7 PIVOT file (#391.71) and mark it as requiring
"^DD",2,2,.132,1,992,"%D",5,0)
transmission of an HL7 demographic A08 update message to the COTS
"^DD",2,2,.132,1,992,"%D",6,0)
interface.
"^DD",2,2,.132,1,992,"%D",7,0)
 
"^DD",2,2,.132,1,992,"%D",8,0)
The local variable DGRUGA08 will be set to 1 if the cross reference is
"^DD",2,2,.132,1,992,"%D",9,0)
not to be executed as part of a re-indexing.
"^DD",2,2,.132,1,992,"DT")
2990920
"^DD",2,2,.132,1,22700,0)
2^ATMGPHONEWORK
"^DD",2,2,.132,1,22700,1)
N % S %=$E($TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%^&*()-_=+[]{}<>,./?:;'\|"),1,30) S:%'="" ^DPT("ATMGPHONEWORK",%,DA)=""
"^DD",2,2,.132,1,22700,2)
N % S %=$E($TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%^&*()-_=+[]{}<>,./?:;'\|"),1,30) K:%'="" ^DPT("ATMGPHONEWORK",%,DA)
"^DD",2,2,.132,1,22700,"%D",0)
^^2^2^3091106^^
"^DD",2,2,.132,1,22700,"%D",1,0)
Created by K. Toppenberg (TMG) for lookup
"^DD",2,2,.132,1,22700,"%D",2,0)
based on work phone.
"^DD",2,2,.132,1,22700,"DT")
3091106
"^DD",2,2,.132,3)
If employed, enter the telephone number of this applicants place of employment [4-20 characters].
"^DD",2,2,.132,20,0)
^.3LA^1^1
"^DD",2,2,.132,20,1,0)
PEMP
"^DD",2,2,.132,21,0)
^^2^2^2861007^
"^DD",2,2,.132,21,1,0)
Enter the office phone number [4-20 characters] where this applicant
"^DD",2,2,.132,21,2,0)
can be reached while employed, if employed.
"^DD",2,2,.132,"AUDIT")
y
"^DD",2,2,.132,"DT")
3091106
"^DD",2,2,.134,0)
PHONE NUMBER [CELLULAR]^FX^^.13;4^K:$L(X)>20!($L(X)<4) X I $D(X) N CTR,CHR,VAR S VAR=X F CTR=1:1:20 S CHR=$E(VAR,CTR) K:("1234567890 -()."'[CHR) X
"^DD",2,2,.134,.1)
Cell Phone
"^DD",2,2,.134,1,0)
^.1
"^DD",2,2,.134,1,22700,0)
2^ATMGPHONECELL
"^DD",2,2,.134,1,22700,1)
N % S %=$E($TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%^&*()-_=+[]{}<>,./?:;'\|"),1,30) S:%'="" ^DPT("ATMGPHONECELL",%,DA)=""
"^DD",2,2,.134,1,22700,2)
N % S %=$E($TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%^&*()-_=+[]{}<>,./?:;'\|"),1,30) K:%'="" ^DPT("ATMGPHONECELL",%,DA)
"^DD",2,2,.134,1,22700,"%D",0)
^^2^2^3091106^^
"^DD",2,2,.134,1,22700,"%D",1,0)
Created by K. Toppenberg (TMG) for lookup
"^DD",2,2,.134,1,22700,"%D",2,0)
based on cell phone.
"^DD",2,2,.134,1,22700,"DT")
3091106
"^DD",2,2,.134,3)
Answer must be 4-20 characters in length, be numeric with only spaces, parenthesis, periods, and dashes for separators.
"^DD",2,2,.134,21,0)
^^2^2^3050111^
"^DD",2,2,.134,21,1,0)
Enter the telephone number [4-20 characters] to the applicant's
"^DD",2,2,.134,21,2,0)
mobile phone.
"^DD",2,2,.134,"DT")
3091106
**END**
**END**