KIDS Distribution saved on Nov 08, 2012@16:03:46 Veterans Transportation System DG*5.3*853. **KIDS**:DG*5.3*853^ **INSTALL NAME** DG*5.3*853 "BLD",19801,0) DG*5.3*853^REGISTRATION^0^3121108^y "BLD",19801,1,0) ^^2^2^3120912^^ "BLD",19801,1,1,0) Please refer to the National Patch Module for the detail of this "BLD",19801,1,2,0) patch build. "BLD",19801,4,0) ^9.64PA^2^1 "BLD",19801,4,2,0) 2 "BLD",19801,4,2,2,0) ^9.641^2^1 "BLD",19801,4,2,2,2,0) PATIENT (File-top level) "BLD",19801,4,2,2,2,1,0) ^9.6411^3000^1 "BLD",19801,4,2,2,2,1,3000,0) VTS PATIENT FLAG "BLD",19801,4,2,222) y^n^p^^^^n^^n "BLD",19801,4,2,224) "BLD",19801,4,"APDD",2,2) "BLD",19801,4,"APDD",2,2,3000) "BLD",19801,4,"B",2,2) "BLD",19801,6) 4^ "BLD",19801,6.3) 104 "BLD",19801,"ABPKG") n "BLD",19801,"INID") ^ "BLD",19801,"INIT") "BLD",19801,"KRN",0) ^9.67PA^779.2^20 "BLD",19801,"KRN",.4,0) .4 "BLD",19801,"KRN",.4,"NM",0) ^9.68A^^ "BLD",19801,"KRN",.401,0) .401 "BLD",19801,"KRN",.402,0) .402 "BLD",19801,"KRN",.403,0) .403 "BLD",19801,"KRN",.5,0) .5 "BLD",19801,"KRN",.84,0) .84 "BLD",19801,"KRN",3.6,0) 3.6 "BLD",19801,"KRN",3.8,0) 3.8 "BLD",19801,"KRN",9.2,0) 9.2 "BLD",19801,"KRN",9.8,0) 9.8 "BLD",19801,"KRN",9.8,"NM",0) ^9.68A^3^3 "BLD",19801,"KRN",9.8,"NM",1,0) DGVTS00^^0^B38863045 "BLD",19801,"KRN",9.8,"NM",2,0) DGVTSA28^^0^B2609481 "BLD",19801,"KRN",9.8,"NM",3,0) DGVTSFS^^0^B3143489 "BLD",19801,"KRN",9.8,"NM","B","DGVTS00",1) "BLD",19801,"KRN",9.8,"NM","B","DGVTSA28",2) "BLD",19801,"KRN",9.8,"NM","B","DGVTSFS",3) "BLD",19801,"KRN",19,0) 19 "BLD",19801,"KRN",19,"NM",0) ^9.68A^1^1 "BLD",19801,"KRN",19,"NM",1,0) DG VTS RIDESHARE^^0 "BLD",19801,"KRN",19,"NM","B","DG VTS RIDESHARE",1) "BLD",19801,"KRN",19.1,0) 19.1 "BLD",19801,"KRN",19.1,"NM",0) ^9.68A^1^1 "BLD",19801,"KRN",19.1,"NM",1,0) DG VTS RIDESHARE^^0 "BLD",19801,"KRN",19.1,"NM","B","DG VTS RIDESHARE",1) "BLD",19801,"KRN",101,0) 101 "BLD",19801,"KRN",101,"NM",0) ^9.68A^3^3 "BLD",19801,"KRN",101,"NM",1,0) DG VTS ADT-A28^^0 "BLD",19801,"KRN",101,"NM",2,0) DG VTS ADT-A28 CLIENT^^0 "BLD",19801,"KRN",101,"NM",3,0) DG VTS ADT-A28 SERVER^^0 "BLD",19801,"KRN",101,"NM","B","DG VTS ADT-A28",1) "BLD",19801,"KRN",101,"NM","B","DG VTS ADT-A28 CLIENT",2) "BLD",19801,"KRN",101,"NM","B","DG VTS ADT-A28 SERVER",3) "BLD",19801,"KRN",409.61,0) 409.61 "BLD",19801,"KRN",409.61,"NM",0) ^9.68A^^0 "BLD",19801,"KRN",771,0) 771 "BLD",19801,"KRN",771,"NM",0) ^9.68A^2^2 "BLD",19801,"KRN",771,"NM",1,0) VISTA_VTS^^0 "BLD",19801,"KRN",771,"NM",2,0) AITC_VTS^^0 "BLD",19801,"KRN",771,"NM","B","AITC_VTS",2) "BLD",19801,"KRN",771,"NM","B","VISTA_VTS",1) "BLD",19801,"KRN",779.2,0) 779.2 "BLD",19801,"KRN",870,0) 870 "BLD",19801,"KRN",870,"NM",0) ^9.68A^1^1 "BLD",19801,"KRN",870,"NM",1,0) AITC_VTS^^0 "BLD",19801,"KRN",870,"NM","B","AITC_VTS",1) "BLD",19801,"KRN",8989.51,0) 8989.51 "BLD",19801,"KRN",8989.51,"NM",0) ^9.68A^^ "BLD",19801,"KRN",8989.52,0) 8989.52 "BLD",19801,"KRN",8989.52,"NM",0) ^9.68A^^ "BLD",19801,"KRN",8994,0) 8994 "BLD",19801,"KRN","B",.4,.4) "BLD",19801,"KRN","B",.401,.401) "BLD",19801,"KRN","B",.402,.402) "BLD",19801,"KRN","B",.403,.403) "BLD",19801,"KRN","B",.5,.5) "BLD",19801,"KRN","B",.84,.84) "BLD",19801,"KRN","B",3.6,3.6) "BLD",19801,"KRN","B",3.8,3.8) "BLD",19801,"KRN","B",9.2,9.2) "BLD",19801,"KRN","B",9.8,9.8) "BLD",19801,"KRN","B",19,19) "BLD",19801,"KRN","B",19.1,19.1) "BLD",19801,"KRN","B",101,101) "BLD",19801,"KRN","B",409.61,409.61) "BLD",19801,"KRN","B",771,771) "BLD",19801,"KRN","B",779.2,779.2) "BLD",19801,"KRN","B",870,870) "BLD",19801,"KRN","B",8989.51,8989.51) "BLD",19801,"KRN","B",8989.52,8989.52) "BLD",19801,"KRN","B",8994,8994) "BLD",19801,"QDEF") ^^^^NO^^^^YES^^NO "BLD",19801,"QUES",0) ^9.62^^ "BLD",19801,"REQB",0) ^9.611^^0 "FIA",2) PATIENT "FIA",2,0) ^DPT( "FIA",2,0,0) 2I "FIA",2,0,1) y^n^p^^^^n^^n "FIA",2,0,10) "FIA",2,0,11) "FIA",2,0,"RLRO") "FIA",2,0,"VR") 5.3^DG "FIA",2,2) 1 "FIA",2,2,3000) "KRN",19,13356,-1) 0^1 "KRN",19,13356,0) DG VTS RIDESHARE^Send New Patient to RideShare (COTS)^^R^^DG VTS RIDESHARE^^^^^^REGISTRATION "KRN",19,13356,1,0) ^19.06^1^1^3121108^^^^ "KRN",19,13356,1,1,0) Allows user to enroll a patient for RideShare. "KRN",19,13356,25) EN^DGVTSFS "KRN",19,13356,"U") SEND NEW PATIENT TO RIDESHARE "KRN",19.1,589,-1) 0^1 "KRN",19.1,589,0) DG VTS RIDESHARE^ "KRN",19.1,589,1,0) ^19.11^2^2^3120912^^^^ "KRN",19.1,589,1,1,0) This key will only be allocated to users of the DG VTS RIDESHARE option "KRN",19.1,589,1,2,0) of the Veterans Transportation System. "KRN",101,6267,-1) 0^3 "KRN",101,6267,0) DG VTS ADT-A28 SERVER^DG VTS ADT-A28 SERVER^^E^^^^^^^^ "KRN",101,6267,1,0) ^101.06^2^2^3120912^^ "KRN",101,6267,1,1,0) This protocol is used to send an Hl7 v2.4 ADT-A28 message from VistA to "KRN",101,6267,1,2,0) RouteMatch. "KRN",101,6267,99) 62712,58272 "KRN",101,6267,770) VISTA_VTS^^ADT^A28^^^^AL^NE^2.4^ "KRN",101,6267,775,0) ^101.0775PA^1^1 "KRN",101,6267,775,1,0) 6269 "KRN",101,6267,775,1,"^") DG VTS ADT-A28 CLIENT "KRN",101,6268,-1) 0^1 "KRN",101,6268,0) DG VTS ADT-A28^DG VTS ADT-A28^^E^^^^^^^^ "KRN",101,6268,99) 62712,58093 "KRN",101,6268,770) VISTA_VTS^^ADT^A28^^^^AL^^2.4^ "KRN",101,6268,775,0) ^101.0775PA^^ "KRN",101,6269,-1) 0^2 "KRN",101,6269,0) DG VTS ADT-A28 CLIENT^DG VTS ADT-A28 CLIENT^^S^^^^^^^^ "KRN",101,6269,1,0) ^^2^2^3120912^ "KRN",101,6269,1,1,0) This is the subscriber protocol to DG VTS ADT-A28 SERVER protocol "KRN",101,6269,1,2,0) that sends HL7 message to RouteMatch. "KRN",101,6269,99) 62712,58182 "KRN",101,6269,770) ^AITC_VTS^^A28^^^^^^^ACK "KRN",101,6269,771) Q "KRN",101,6269,773) 1^1 "KRN",101,6269,774) Q "KRN",771,226,-1) 0^1 "KRN",771,226,0) VISTA_VTS^a^500^^^^USA "KRN",771,226,"EC") ^~\& "KRN",771,226,"FS") | "KRN",771,227,-1) 0^2 "KRN",771,227,0) AITC_VTS^a^200^^^^USA "KRN",870,133,-1) 0^1 "KRN",870,133,0) AITC_VTS^^TCP^^^^^^^^^^^^^^^^^^10 "KRN",870,133,200) ^^^60^60 "KRN",870,133,400) ^8090^C^N^60^^^^ "MBREQ") 0 "ORD",3,19.1) 19.1;3;;;KEY^XPDTA1;KEYF1^XPDIA1;KEYE1^XPDIA1;KEYF2^XPDIA1;;KEYDEL^XPDIA1 "ORD",3,19.1,0) SECURITY KEY "ORD",13,870) 870;13;1;;HLLL^XPDTA1;;HLLLE^XPDIA1;;;HLLLDEL^XPDIA1(%) "ORD",13,870,0) HL LOGICAL LINK "ORD",14,771) 771;14;;;HLAP^XPDTA1;HLAPF1^XPDIA1;HLAPE1^XPDIA1;HLAPF2^XPDIA1;;HLAPDEL^XPDIA1(%) "ORD",14,771,0) HL7 APPLICATION PARAMETER "ORD",15,101) 101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA "ORD",15,101,0) PROTOCOL "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "PKG",3,-1) 1^1 "PKG",3,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",3,22,0) ^9.49I^1^1 "PKG",3,22,1,0) 5.3^2930813^2930829 "PKG",3,22,1,"PAH",1,0) 853^3121108^4558 "PKG",3,22,1,"PAH",1,1,0) ^^2^2^3121108 "PKG",3,22,1,"PAH",1,1,1,0) Please refer to the National Patch Module for the detail of this "PKG",3,22,1,"PAH",1,1,2,0) patch build. "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") NO "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") NO "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") 3 "RTN","DGVTS00") 0^1^B38863045 "RTN","DGVTS00",1,0) DGVTS00 ;7DELTA/KDC - VTS Stand alone Option routine ;07-MAR-2012 "RTN","DGVTS00",2,0) ;;5.3;REGISTRATION;**853**;07-MAR-2012;Build 104 "RTN","DGVTS00",3,0) Q "RTN","DGVTS00",4,0) ; This routine was built for the Veterans Transportation Service (VTS) project. "RTN","DGVTS00",5,0) ; A flat file is created from the RouteMatch database containing its Veteran population. "RTN","DGVTS00",6,0) ; The flat file will contain Veteran name, address and phone number. The routine reads "RTN","DGVTS00",7,0) ; a record from the flat file and tries to find the corresponding Veteran in VistA. "RTN","DGVTS00",8,0) ; A match is only made if all fields (name, city, state, zip code and phone number) match. "RTN","DGVTS00",9,0) ; Otherwise the record that was read in is written out to an exception report file "RTN","DGVTS00",10,0) ; containing Veteran's for whom the process could not determine a match. If a match "RTN","DGVTS00",11,0) ; is found then the ICN associated with the Veteran is appended to the record that "RTN","DGVTS00",12,0) ; was read in and written out to the output file. The output file will be sent to "RTN","DGVTS00",13,0) ; RouteMatch to be loaded into their database. "RTN","DGVTS00",14,0) ; "RTN","DGVTS00",15,0) Q "RTN","DGVTS00",16,0) ; "RTN","DGVTS00",17,0) ; Entry point for the process "RTN","DGVTS00",18,0) ; A call to allow for the variable ZEOF to catch End of File "RTN","DGVTS00",19,0) ; "RTN","DGVTS00",20,0) EN ; "RTN","DGVTS00",21,0) N DLM,STOP,INPUTFILE,REC,FOUND,ICN,IEN,NAME "RTN","DGVTS00",22,0) N RMNAME,FNAME,LNAME,MI,PATADD,FLG,CITY,ZIP "RTN","DGVTS00",23,0) N STATE,PHONE,DFN,RMREC,DA,DIE,DR,IO,STATION "RTN","DGVTS00",24,0) N ICNFILE,REPORTFILE,DIR,INPUT,POP,ADD1,ADD2 "RTN","DGVTS00",25,0) ; Define the delimiter characters "RTN","DGVTS00",26,0) S DLM="," "RTN","DGVTS00",27,0) ; "RTN","DGVTS00",28,0) ; Get Primary Station Number from File 389.9 - Station Number (Time Sensitive) "RTN","DGVTS00",29,0) ; Node 0 Piece 4 ^VA(389.9 "RTN","DGVTS00",30,0) ; SITE^VASITE returns the Station Number in the third argument "RTN","DGVTS00",31,0) S STATION=+$P($$SITE^VASITE(),"^",3) "RTN","DGVTS00",32,0) ; "RTN","DGVTS00",33,0) ; "RTN","DGVTS00",34,0) ; Call to open the file "RTN","DGVTS00",35,0) ; If any of the files could not be opened the process stops "RTN","DGVTS00",36,0) ; "RTN","DGVTS00",37,0) S STOP=0 "RTN","DGVTS00",38,0) D OPENFILE Q:STOP "RTN","DGVTS00",39,0) ; "RTN","DGVTS00",40,0) ; Read records from input file "RTN","DGVTS00",41,0) ; Extract fields from the record "RTN","DGVTS00",42,0) ; Compare the VistA patient information to the data in the fields "RTN","DGVTS00",43,0) ; from the input record "RTN","DGVTS00",44,0) LOOP ; "RTN","DGVTS00",45,0) USE INPUTFILE "RTN","DGVTS00",46,0) READ REC:5 I $$STATUS^%ZISH G CL "RTN","DGVTS00",47,0) I REC=$C(13,10) G LOOP "RTN","DGVTS00",48,0) D EXDATA "RTN","DGVTS00",49,0) D COMP "RTN","DGVTS00",50,0) G LOOP "RTN","DGVTS00",51,0) ; Compare information "RTN","DGVTS00",52,0) COMP ; "RTN","DGVTS00",53,0) ; Initialize variables "RTN","DGVTS00",54,0) ; If variable FOUND is set than we have a successful match "RTN","DGVTS00",55,0) ; Variable IEN is used to loop through the patient file for a set "RTN","DGVTS00",56,0) ; Veteran name "RTN","DGVTS00",57,0) ; (there can be several patients with the same name) "RTN","DGVTS00",58,0) ; Variable ICN will be populated with the matching Veterans ICN "RTN","DGVTS00",59,0) ; "RTN","DGVTS00",60,0) S FOUND=0 "RTN","DGVTS00",61,0) S IEN=0 "RTN","DGVTS00",62,0) S ICN="" "RTN","DGVTS00",63,0) S RMNAME=LNAME_","_FNAME "RTN","DGVTS00",64,0) S:MI]"" RMNAME=RMNAME_" "_MI "RTN","DGVTS00",65,0) S NAME=RMNAME "RTN","DGVTS00",66,0) ; "RTN","DGVTS00",67,0) ; If name field is missing skip compare and go straight to writing "RTN","DGVTS00",68,0) ; data to a report file "RTN","DGVTS00",69,0) ; "RTN","DGVTS00",70,0) I NAME']"" G CPOUT "RTN","DGVTS00",71,0) ; "RTN","DGVTS00",72,0) ; Loop through patient name index to try and find the matching "RTN","DGVTS00",73,0) ; Veteran "RTN","DGVTS00",74,0) ; with the given name or a match was found "RTN","DGVTS00",75,0) CP1 S IEN=$O(^DPT("B",NAME,IEN)) G:FOUND>1 CPOUT G:'IEN CP "RTN","DGVTS00",76,0) ; "RTN","DGVTS00",77,0) ; Set variable PATADD with the patient's address information "RTN","DGVTS00",78,0) ; "RTN","DGVTS00",79,0) S PATADD=$$UP($G(^DPT(IEN,.11))) "RTN","DGVTS00",80,0) ; "RTN","DGVTS00",81,0) ; Variable FLG is used to indicate if data is a match or not "RTN","DGVTS00",82,0) ; "RTN","DGVTS00",83,0) S FLG=0 "RTN","DGVTS00",84,0) ; "RTN","DGVTS00",85,0) I $P(PATADD,U,4)=CITY,$P(PATADD,U,6)=ZIP S FLG=1 "RTN","DGVTS00",86,0) ; "RTN","DGVTS00",87,0) ; If data did not match loop back to see if there are more patients "RTN","DGVTS00",88,0) ; with the given name to check "RTN","DGVTS00",89,0) ; "RTN","DGVTS00",90,0) ; Reset FLG and compare STATE field "RTN","DGVTS00",91,0) ; "RTN","DGVTS00",92,0) I FLG=0 G CP1 "RTN","DGVTS00",93,0) S FLG=0 "RTN","DGVTS00",94,0) I $P(PATADD,U,5)]"",STATE=$P($G(^DIC(5,$P(PATADD,U,5),0)),U,2) S FLG=1 "RTN","DGVTS00",95,0) I STATE="",$P(PATADD,U,5)="" S FLG=1 "RTN","DGVTS00",96,0) ; "RTN","DGVTS00",97,0) ; If data did not match loop back to see if there are more patients "RTN","DGVTS00",98,0) ; with the given name to check "RTN","DGVTS00",99,0) ; "RTN","DGVTS00",100,0) I FLG=0 G CP1 "RTN","DGVTS00",101,0) S FLG=0 "RTN","DGVTS00",102,0) ; "RTN","DGVTS00",103,0) ; compare components of the phone number "RTN","DGVTS00",104,0) ; "RTN","DGVTS00",105,0) ; If phone number matches set variable FOUND and ICN "RTN","DGVTS00",106,0) I $TR(PHONE,"()-. :")=$TR($P($G(^DPT(IEN,.13)),U),"()-. :") D "RTN","DGVTS00",107,0) . S FOUND=FOUND+1 "RTN","DGVTS00",108,0) . ;S ICN=$P($G(^DPT(IEN,"MPI")),U) "RTN","DGVTS00",109,0) . S DFN=IEN "RTN","DGVTS00",110,0) . S ICN=+($$GETICN^MPIF001(DFN)) "RTN","DGVTS00",111,0) ; "RTN","DGVTS00",112,0) ; If MPIF001 returns -1 error - patient not in database "RTN","DGVTS00",113,0) ; Set FOUND to indicate Veteran not found and place "RTN","DGVTS00",114,0) ; entry on Exception report "RTN","DGVTS00",115,0) ; "RTN","DGVTS00",116,0) I +ICN=-1 S FOUND=0 G CPOUT "RTN","DGVTS00",117,0) ; "RTN","DGVTS00",118,0) G CP1 "RTN","DGVTS00",119,0) ; "RTN","DGVTS00",120,0) ; Look to see if there are additional patients to examine "RTN","DGVTS00",121,0) ; "RTN","DGVTS00",122,0) CP S NAME=$O(^DPT("B",NAME)) G:NAME="" CPOUT "RTN","DGVTS00",123,0) ; "RTN","DGVTS00",124,0) ; if there was no middle initial then the name must match exactly "RTN","DGVTS00",125,0) ; "RTN","DGVTS00",126,0) I MI="",NAME'=RMNAME G CPOUT "RTN","DGVTS00",127,0) I MI]"",NAME'[RMNAME G CPOUT "RTN","DGVTS00",128,0) ; "RTN","DGVTS00",129,0) ; if there was a middle initial then keep looking as long as the "RTN","DGVTS00",130,0) ; VistA patient name totaly contains the name from RouteMatch "RTN","DGVTS00",131,0) ; "RTN","DGVTS00",132,0) G CP1 "RTN","DGVTS00",133,0) ; "RTN","DGVTS00",134,0) ; Determine which file to write information in based on the value "RTN","DGVTS00",135,0) ; of the variable FOUND "RTN","DGVTS00",136,0) CPOUT ; "RTN","DGVTS00",137,0) I FOUND=0!(FOUND>1) U REPORTFILE W REC,! Q "RTN","DGVTS00",138,0) ; If match was found then build record with additional data elements "RTN","DGVTS00",139,0) ; to be returned "RTN","DGVTS00",140,0) ; "RTN","DGVTS00",141,0) ; Record format "RTN","DGVTS00",142,0) ; 1. DFN "RTN","DGVTS00",143,0) ; 2. Last 4 of SSN "RTN","DGVTS00",144,0) ; 3. Last Name "RTN","DGVTS00",145,0) ; 4. First Name "RTN","DGVTS00",146,0) ; 5. Middle Initial "RTN","DGVTS00",147,0) ; 6. Address Line 1 "RTN","DGVTS00",148,0) ; 7. Address Line 2 "RTN","DGVTS00",149,0) ; 8. City "RTN","DGVTS00",150,0) ; 9. State "RTN","DGVTS00",151,0) ; 10. Zip "RTN","DGVTS00",152,0) ; 11. Phone "RTN","DGVTS00",153,0) ; 12. ICN "RTN","DGVTS00",154,0) ; "RTN","DGVTS00",155,0) S RMREC="" "RTN","DGVTS00",156,0) S $P(RMREC,",")=$$TRIM(DFN) "RTN","DGVTS00",157,0) S $P(RMREC,",",2)=$E($P($G(^DPT(DFN,0)),U,9),6,9) "RTN","DGVTS00",158,0) S $P(RMREC,",",3)=$$TRIM(LNAME) "RTN","DGVTS00",159,0) S $P(RMREC,",",4)=$$TRIM(FNAME) "RTN","DGVTS00",160,0) S $P(RMREC,",",5)=$$TRIM(MI) "RTN","DGVTS00",161,0) S $P(RMREC,",",6)=$$TRIM(ADD1) "RTN","DGVTS00",162,0) S $P(RMREC,",",7)=$$TRIM(ADD2) "RTN","DGVTS00",163,0) S $P(RMREC,",",8)=$$TRIM(CITY) "RTN","DGVTS00",164,0) S $P(RMREC,",",9)=$$TRIM(STATE) "RTN","DGVTS00",165,0) S $P(RMREC,",",10)=$$TRIM(ZIP) "RTN","DGVTS00",166,0) S PHONE=$TR(PHONE,"()-. :") "RTN","DGVTS00",167,0) I $L(PHONE)=10 S PHONE="("_$E(PHONE,1,3)_")"_$E(PHONE,4,6)_"-"_$E(PHONE,7,10) "RTN","DGVTS00",168,0) S $P(RMREC,",",11)=$$TRIM(PHONE) "RTN","DGVTS00",169,0) S $P(RMREC,",",12)=$$TRIM(ICN) "RTN","DGVTS00",170,0) ; "RTN","DGVTS00",171,0) U ICNFILE W RMREC,! "RTN","DGVTS00",172,0) ; "RTN","DGVTS00",173,0) ; Match found - Set the Patient Flag indicating "RTN","DGVTS00",174,0) ; patient is part of the VTS program "RTN","DGVTS00",175,0) ; "RTN","DGVTS00",176,0) L +^DPT(DFN):5 I '$T QUIT "RTN","DGVTS00",177,0) S DIE=2,DA=DFN,DR="3000///1" D ^DIE "RTN","DGVTS00",178,0) L -^DPT(DFN) "RTN","DGVTS00",179,0) ; "RTN","DGVTS00",180,0) QUIT "RTN","DGVTS00",181,0) ; "RTN","DGVTS00",182,0) ; Open files "RTN","DGVTS00",183,0) ; Open the input file and the two output files (the exception report "RTN","DGVTS00",184,0) ; and the ICN included files "RTN","DGVTS00",185,0) ; If the process could not open the files write information to the "RTN","DGVTS00",186,0) ; screen and stop the process. "RTN","DGVTS00",187,0) ; "RTN","DGVTS00",188,0) OPENFILE ; "RTN","DGVTS00",189,0) R !,"Enter the directory where files are located: ",DIR:60,! "RTN","DGVTS00",190,0) I DIR="" W !,"No directory supplied, process stopped" S STOP=1 Q "RTN","DGVTS00",191,0) R !,"Enter input file name: ",INPUT:60,!! "RTN","DGVTS00",192,0) I INPUT="" W !,"No input file name, process stopped" S STOP=1 Q "RTN","DGVTS00",193,0) ; Opening input file "RTN","DGVTS00",194,0) ; "RTN","DGVTS00",195,0) ; "RTN","DGVTS00",196,0) D OPEN^%ZISH("",DIR,INPUT,"R") "RTN","DGVTS00",197,0) I POP D "RTN","DGVTS00",198,0) . W !,"Unable to open input file: "_DIR_INPUT,!,"Process stopped" "RTN","DGVTS00",199,0) . S STOP=1 "RTN","DGVTS00",200,0) ; "RTN","DGVTS00",201,0) I STOP=1 Q "RTN","DGVTS00",202,0) S INPUTFILE=IO "RTN","DGVTS00",203,0) ; "RTN","DGVTS00",204,0) ; Opening ICN included file "RTN","DGVTS00",205,0) ; "RTN","DGVTS00",206,0) ; "RTN","DGVTS00",207,0) D OPEN^%ZISH("",DIR,STATION_"_ICNOUTPUT.CSV","WN") "RTN","DGVTS00",208,0) I POP D "RTN","DGVTS00",209,0) . W !,"Unable to open output file: "_DIR_STATION_"_ICNOUTPUT.CSV",!,"Process stopped" "RTN","DGVTS00",210,0) . S IO=INPUTFILE "RTN","DGVTS00",211,0) . D CLOSE^%ZISH(INPUTFILE) S STOP=1 Q "RTN","DGVTS00",212,0) ; "RTN","DGVTS00",213,0) I STOP=1 Q "RTN","DGVTS00",214,0) S ICNFILE=IO "RTN","DGVTS00",215,0) ; "RTN","DGVTS00",216,0) ; Opening the exception exception report file "RTN","DGVTS00",217,0) ; "RTN","DGVTS00",218,0) ; "RTN","DGVTS00",219,0) D OPEN^%ZISH("",DIR,STATION_"_EXCEPTION.CSV","WN") "RTN","DGVTS00",220,0) I POP D "RTN","DGVTS00",221,0) . W !,"Unable to open report file: "_DIR_STATION_"_EXCEPTION.CSV",!,"Process stopped" "RTN","DGVTS00",222,0) . S IO=INPUTFILE "RTN","DGVTS00",223,0) . D CLOSE^%ZISH(INPUTFILE) "RTN","DGVTS00",224,0) . S IO=ICNFILE "RTN","DGVTS00",225,0) . D CLOSE^%ZISH(ICNFILE) "RTN","DGVTS00",226,0) . S STOP=1 "RTN","DGVTS00",227,0) S REPORTFILE=IO "RTN","DGVTS00",228,0) Q "RTN","DGVTS00",229,0) ; "RTN","DGVTS00",230,0) ; Extract fields from the input record "RTN","DGVTS00",231,0) ; variable REC contains the input record information "RTN","DGVTS00",232,0) ; layout of record is "RTN","DGVTS00",233,0) ; "RTN","DGVTS00",234,0) ;Last Name "RTN","DGVTS00",235,0) ;First Name "RTN","DGVTS00",236,0) ;Middle Initial "RTN","DGVTS00",237,0) ;Address Line 1 "RTN","DGVTS00",238,0) ;Address Line 2 "RTN","DGVTS00",239,0) ;City "RTN","DGVTS00",240,0) ;State "RTN","DGVTS00",241,0) ;ZIP "RTN","DGVTS00",242,0) ;Phone Number "RTN","DGVTS00",243,0) EXDATA ; "RTN","DGVTS00",244,0) S LNAME=$$TRIM($$UP($P(REC,DLM))) "RTN","DGVTS00",245,0) S FNAME=$$TRIM($$UP($P(REC,DLM,2))) "RTN","DGVTS00",246,0) S MI=$$TRIM($$UP($P(REC,DLM,3))) "RTN","DGVTS00",247,0) S ADD1=$$UP($P(REC,DLM,4)) "RTN","DGVTS00",248,0) S ADD2=$$UP($P(REC,DLM,5)) "RTN","DGVTS00",249,0) S CITY=$$TRIM($$UP($P(REC,DLM,6))) "RTN","DGVTS00",250,0) S STATE=$$TRIM($$UP($P(REC,DLM,7))) "RTN","DGVTS00",251,0) S ZIP=$$TRIM($$UP($P(REC,DLM,8))) "RTN","DGVTS00",252,0) S PHONE=$$UP($P(REC,DLM,9)) "RTN","DGVTS00",253,0) Q "RTN","DGVTS00",254,0) ; Change lowercase to uppercase "RTN","DGVTS00",255,0) UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","DGVTS00",256,0) ; "RTN","DGVTS00",257,0) ;Remove leading and trailing spaces "RTN","DGVTS00",258,0) TRIM(DATA) ; "RTN","DGVTS00",259,0) N I,J "RTN","DGVTS00",260,0) F I=1:1 Q:$E(DATA,I)'=" " "RTN","DGVTS00",261,0) F J=$L(DATA):-1 Q:$E(DATA,J)'=" " "RTN","DGVTS00",262,0) Q $E(DATA,I,J) "RTN","DGVTS00",263,0) ; "RTN","DGVTS00",264,0) ; Close all files and write that the process has completed "RTN","DGVTS00",265,0) ; "RTN","DGVTS00",266,0) CL ; "RTN","DGVTS00",267,0) S IO=ICNFILE "RTN","DGVTS00",268,0) D CLOSE^%ZISH(ICNFILE) "RTN","DGVTS00",269,0) S IO=REPORTFILE "RTN","DGVTS00",270,0) D CLOSE^%ZISH(REPORTFILE) "RTN","DGVTS00",271,0) S IO=INPUTFILE "RTN","DGVTS00",272,0) D CLOSE^%ZISH(INPUTFILE) "RTN","DGVTS00",273,0) U 0 "RTN","DGVTS00",274,0) WRITE !,"Process complete",! "RTN","DGVTS00",275,0) QUIT "RTN","DGVTSA28") 0^2^B2609481 "RTN","DGVTSA28",1,0) DGVTSA28 ;7DELTA/KDC - VTS Stand alone Option routine ;07-MAR-2012 "RTN","DGVTSA28",2,0) ;;5.3;REGISTRATION;**853**;07-MAR-2012;Build 104 "RTN","DGVTSA28",3,0) ; "RTN","DGVTSA28",4,0) ; Integration Agreements Utilized: "RTN","DGVTSA28",5,0) ; START, EXC, STOP^RGHLLOG - #2796 "RTN","DGVTSA28",6,0) ; BLDEVN, BLDPD1, BLDPID^VAFCQRY - #3630 "RTN","DGVTSA28",7,0) ; "RTN","DGVTSA28",8,0) A28(DFN) ;BUILD AND SEND A28 "RTN","DGVTSA28",9,0) N RESLT,CNT,MPI,EVN,TCNT,ERR,PD1,PID "RTN","DGVTSA28",10,0) N HL,MTIEN,HLDT,HLDT1,HLL,HLMID,HLNEXT "RTN","DGVTSA28",11,0) K HLA("HLA"),HLA("HLS") "RTN","DGVTSA28",12,0) S CNT=1 "RTN","DGVTSA28",13,0) D INIT^HLFNC2("DG VTS ADT-A28 SERVER",.HL) "RTN","DGVTSA28",14,0) I $O(HL(""))="" Q "-1^"_$P(HL,"^",2) "RTN","DGVTSA28",15,0) S HLECH=HL("ECH"),HLFS=HL("FS"),COMP=$E(HL("ECH"),1),REP=$E(HL("ECH"),2),SUBCOMP=$E(HL("ECH"),4) "RTN","DGVTSA28",16,0) D CREATE^HLTF(.HLMID,.MTIEN,.HLDT,.HLDT1) "RTN","DGVTSA28",17,0) S ERR="",TCNT=0 "RTN","DGVTSA28",18,0) N NODE "RTN","DGVTSA28",19,0) S EVN(1)=$$EVN^VAFHLEVN("A28",4,) "RTN","DGVTSA28",20,0) Q:ERR'="" ERR "RTN","DGVTSA28",21,0) D BLDPID^VAFCQRY(DFN,1,"ALL",.PID,.HL,.ERR) "RTN","DGVTSA28",22,0) Q:ERR'="" ERR "RTN","DGVTSA28",23,0) S PD1(1)=$$EN^VAFHLPD1(DFN,",3,") "RTN","DGVTSA28",24,0) Q:ERR'="" ERR "RTN","DGVTSA28",25,0) S HLA("HLS",1)=EVN(1) "RTN","DGVTSA28",26,0) S HLA("HLS",3)=PD1(1) "RTN","DGVTSA28",27,0) S CNT=0 F S CNT=$O(PID(CNT)) Q:CNT="" D "RTN","DGVTSA28",28,0) .I CNT=1 S HLA("HLS",2)=PID(CNT) "RTN","DGVTSA28",29,0) .I CNT>1 S HLA("HLS",2,CNT-1)=PID(CNT) "RTN","DGVTSA28",30,0) S HLA("HLS",4)=$$EN1^VAFHLZPD(DFN,"1,17,21,34") "RTN","DGVTSA28",31,0) S HLL("LINKS",1)="DG VTS ADT-A28 CLIENT^AITC_VTS" "RTN","DGVTSA28",32,0) D GENERATE^HLMA("DG VTS ADT-A28 SERVER","LM",1,.RESLT,MTIEN) "RTN","DGVTSA28",33,0) K HLA,HLEID,HLL("LINKS"),COMP,REP,SUBCOMP,HLECH,HLFS,HLA("HLA"),HLA("HLS"),MPIFRSLT "RTN","DGVTSA28",34,0) Q "RTN","DGVTSFS") 0^3^B3143489 "RTN","DGVTSFS",1,0) DGVTSFS ;7DELTA/KDC - VTS Stand alone Option routine ;07-MAR-2012 "RTN","DGVTSFS",2,0) ;;5.3;REGISTRATION;**853**;07-MAR-2012;Build 104 "RTN","DGVTSFS",3,0) Q "RTN","DGVTSFS",4,0) EN ;Entry point for stand-alone RideShare sign-up option "RTN","DGVTSFS",5,0) ;This routine provides the option to SET the VTS Patient "RTN","DGVTSFS",6,0) ;Flag in File #2 (Patient File) which indicates that the "RTN","DGVTSFS",7,0) ;patient is enrolled in RideShare "RTN","DGVTSFS",8,0) ; "RTN","DGVTSFS",9,0) ; "RTN","DGVTSFS",10,0) ; SET (YES) - 1 "RTN","DGVTSFS",11,0) ; Not SET (NO) -0 or "" "RTN","DGVTSFS",12,0) ; "RTN","DGVTSFS",13,0) ;An HL7 ADT-A28 (ADD) message is built/sent "RTN","DGVTSFS",14,0) ; Input -- None "RTN","DGVTSFS",15,0) ; Output -- None "RTN","DGVTSFS",16,0) ; "RTN","DGVTSFS",17,0) ; "RTN","DGVTSFS",18,0) ; "RTN","DGVTSFS",19,0) ; "RTN","DGVTSFS",20,0) N DFN "RTN","DGVTSFS",21,0) ; "RTN","DGVTSFS",22,0) ;Get Patient file (#2) IEN - DFN "RTN","DGVTSFS",23,0) EN1 D GETPAT^DGRPTU(,,.DFN,) G ENQ:DFN<0 "RTN","DGVTSFS",24,0) L +^DPT(DFN):5 I '$T W !,"Patient record is currently locked, Try again later." G EN1 "RTN","DGVTSFS",25,0) ; "RTN","DGVTSFS",26,0) E1 ; Retrieve patient's VTS flag information "RTN","DGVTSFS",27,0) N DIC,DR,DA,%,DIE,DGVTRSF "RTN","DGVTSFS",28,0) S DGVTRSF=$$GET1^DIQ(2,DFN_",",3000) "RTN","DGVTSFS",29,0) W !,"The VTS Patient Flag is currently: ",DGVTRSF "RTN","DGVTSFS",30,0) I DGVTRSF="YES" W !,"Patient is already a RideShare participant" L -^DPT(DFN) K DFN G EN1 "RTN","DGVTSFS",31,0) W !!,"Are you sure you want to enroll patient in RideShare",!,"and set the VTS Patient Flag" "RTN","DGVTSFS",32,0) D YN^DICN I %Y["?" W !!,"Enter YES or NO.",! G E1 "RTN","DGVTSFS",33,0) I %'=1 L -^DPT(DFN) G ENQ "RTN","DGVTSFS",34,0) S DIE=2,DA=DFN,DR="3000///1" D ^DIE "RTN","DGVTSFS",35,0) L -^DPT(DFN) "RTN","DGVTSFS",36,0) ; "RTN","DGVTSFS",37,0) ; Build and send HL7 ADT-A28 ADD Message "RTN","DGVTSFS",38,0) D A28^DGVTSA28(DFN) "RTN","DGVTSFS",39,0) ; "RTN","DGVTSFS",40,0) W !!,"Patient is now a RideShare participant and VTS Patient Flag is set" "RTN","DGVTSFS",41,0) K DFN "RTN","DGVTSFS",42,0) G EN1 "RTN","DGVTSFS",43,0) ; "RTN","DGVTSFS",44,0) ENQ ; "RTN","DGVTSFS",45,0) K DIQ1 "RTN","DGVTSFS",46,0) Q "VER") 8.0^22.0 "^DD",2,2,3000,0) VTS PATIENT FLAG^S^0:NO;1:YES;^3000;1^Q "^DD",2,2,3000,3) Does this patient want to be in the Veteran Transportation Service (VTS) program? "^DD",2,2,3000,21,0) ^^2^2^3120502^ "^DD",2,2,3000,21,1,0) This field indicates whether or not the patient is or wants to be part of the Veteran "^DD",2,2,3000,21,2,0) Transportation Service (VTS). "^DD",2,2,3000,"DT") 3120502 **END** **END**