Released DVBA*2.7*143 SEQ #134 Extracted from mail message **KIDS**:DVBA*2.7*143^ **INSTALL NAME** DVBA*2.7*143 "BLD",7413,0) DVBA*2.7*143^AUTOMATED MED INFO EXCHANGE^0^3091022^y "BLD",7413,1,0) ^^2^2^3090928^ "BLD",7413,1,1,0) Please refer to patch DVBA*2.7*143 for a complete description of this "BLD",7413,1,2,0) patch. "BLD",7413,4,0) ^9.64PA^8994.5^1 "BLD",7413,4,8994.5,0) 8994.5 "BLD",7413,4,8994.5,222) n^n^f^^y^^y^m^n "BLD",7413,4,8994.5,224) I $P($G(^XWB(8994.5,Y,0)),"^",1)="CAPRIFHIE" "BLD",7413,4,"B",8994.5,8994.5) "BLD",7413,6.3) 4 "BLD",7413,"ABPKG") n "BLD",7413,"INIT") POST^DVBA143P "BLD",7413,"KRN",0) ^9.67PA^779.2^20 "BLD",7413,"KRN",.4,0) .4 "BLD",7413,"KRN",.401,0) .401 "BLD",7413,"KRN",.402,0) .402 "BLD",7413,"KRN",.403,0) .403 "BLD",7413,"KRN",.5,0) .5 "BLD",7413,"KRN",.84,0) .84 "BLD",7413,"KRN",3.6,0) 3.6 "BLD",7413,"KRN",3.8,0) 3.8 "BLD",7413,"KRN",9.2,0) 9.2 "BLD",7413,"KRN",9.8,0) 9.8 "BLD",7413,"KRN",9.8,"NM",0) ^9.68A^8^8 "BLD",7413,"KRN",9.8,"NM",1,0) DVBCUTIL^^0^B33092099 "BLD",7413,"KRN",9.8,"NM",2,0) DVBAB70^^0^B43310973 "BLD",7413,"KRN",9.8,"NM",3,0) DVBCENQ1^^0^B27476723 "BLD",7413,"KRN",9.8,"NM",4,0) DVBABADR^^0^B1913888 "BLD",7413,"KRN",9.8,"NM",5,0) DVBAB84^^0^B36589384 "BLD",7413,"KRN",9.8,"NM",6,0) DVBAB1^^0^B54842893 "BLD",7413,"KRN",9.8,"NM",7,0) DVBAB1B^^0^B11312167 "BLD",7413,"KRN",9.8,"NM",8,0) DVBABURL^^0^B2354419 "BLD",7413,"KRN",9.8,"NM","B","DVBAB1",6) "BLD",7413,"KRN",9.8,"NM","B","DVBAB1B",7) "BLD",7413,"KRN",9.8,"NM","B","DVBAB70",2) "BLD",7413,"KRN",9.8,"NM","B","DVBAB84",5) "BLD",7413,"KRN",9.8,"NM","B","DVBABADR",4) "BLD",7413,"KRN",9.8,"NM","B","DVBABURL",8) "BLD",7413,"KRN",9.8,"NM","B","DVBCENQ1",3) "BLD",7413,"KRN",9.8,"NM","B","DVBCUTIL",1) "BLD",7413,"KRN",19,0) 19 "BLD",7413,"KRN",19,"NM",0) ^9.68A^1^1 "BLD",7413,"KRN",19,"NM",1,0) DVBA CAPRI GUI^^0 "BLD",7413,"KRN",19,"NM","B","DVBA CAPRI GUI",1) "BLD",7413,"KRN",19.1,0) 19.1 "BLD",7413,"KRN",101,0) 101 "BLD",7413,"KRN",409.61,0) 409.61 "BLD",7413,"KRN",771,0) 771 "BLD",7413,"KRN",779.2,0) 779.2 "BLD",7413,"KRN",870,0) 870 "BLD",7413,"KRN",8989.51,0) 8989.51 "BLD",7413,"KRN",8989.51,"NM",0) ^9.68A^3^3 "BLD",7413,"KRN",8989.51,"NM",1,0) DVBAB CAPRI ALLOW OLD VERSION^^0 "BLD",7413,"KRN",8989.51,"NM",2,0) DVBAB CAPRI HIA UPDATE URL^^0 "BLD",7413,"KRN",8989.51,"NM",3,0) DVBAB CAPRI MINIMUM VERSION^^0 "BLD",7413,"KRN",8989.51,"NM","B","DVBAB CAPRI ALLOW OLD VERSION",1) "BLD",7413,"KRN",8989.51,"NM","B","DVBAB CAPRI HIA UPDATE URL",2) "BLD",7413,"KRN",8989.51,"NM","B","DVBAB CAPRI MINIMUM VERSION",3) "BLD",7413,"KRN",8989.52,0) 8989.52 "BLD",7413,"KRN",8994,0) 8994 "BLD",7413,"KRN",8994,"NM",0) ^9.68A^2^2 "BLD",7413,"KRN",8994,"NM",1,0) DVBAB ZIP2CITY^^0 "BLD",7413,"KRN",8994,"NM",2,0) DVBA CHECK PATCH^^0 "BLD",7413,"KRN",8994,"NM","B","DVBA CHECK PATCH",2) "BLD",7413,"KRN",8994,"NM","B","DVBAB ZIP2CITY",1) "BLD",7413,"KRN","B",.4,.4) "BLD",7413,"KRN","B",.401,.401) "BLD",7413,"KRN","B",.402,.402) "BLD",7413,"KRN","B",.403,.403) "BLD",7413,"KRN","B",.5,.5) "BLD",7413,"KRN","B",.84,.84) "BLD",7413,"KRN","B",3.6,3.6) "BLD",7413,"KRN","B",3.8,3.8) "BLD",7413,"KRN","B",9.2,9.2) "BLD",7413,"KRN","B",9.8,9.8) "BLD",7413,"KRN","B",19,19) "BLD",7413,"KRN","B",19.1,19.1) "BLD",7413,"KRN","B",101,101) "BLD",7413,"KRN","B",409.61,409.61) "BLD",7413,"KRN","B",771,771) "BLD",7413,"KRN","B",779.2,779.2) "BLD",7413,"KRN","B",870,870) "BLD",7413,"KRN","B",8989.51,8989.51) "BLD",7413,"KRN","B",8989.52,8989.52) "BLD",7413,"KRN","B",8994,8994) "BLD",7413,"QUES",0) ^9.62^^ "BLD",7413,"REQB",0) ^9.611^7^6 "BLD",7413,"REQB",1,0) DVBA*2.7*140^2 "BLD",7413,"REQB",2,0) DVBA*2.7*136^2 "BLD",7413,"REQB",4,0) DVBA*2.7*126^2 "BLD",7413,"REQB",5,0) DVBA*2.7*146^2 "BLD",7413,"REQB",6,0) XU*8.0*523^2 "BLD",7413,"REQB",7,0) XWB*1.1*53^2 "BLD",7413,"REQB","B","DVBA*2.7*126",4) "BLD",7413,"REQB","B","DVBA*2.7*136",2) "BLD",7413,"REQB","B","DVBA*2.7*140",1) "BLD",7413,"REQB","B","DVBA*2.7*146",5) "BLD",7413,"REQB","B","XU*8.0*523",6) "BLD",7413,"REQB","B","XWB*1.1*53",7) "DATA",8994.5,8,0) CAPRIFHIE^9510^f%p(yoST{$5qR)tgurg "DATA",8994.5,8,1,0) ^8994.51S^1^1 "DATA",8994.5,8,1,1,0) S^-1^XXX "FIA",8994.5) REMOTE APPLICATION "FIA",8994.5,0) ^XWB(8994.5, "FIA",8994.5,0,0) 8994.5 "FIA",8994.5,0,1) n^n^f^^y^^y^m^n "FIA",8994.5,0,10) "FIA",8994.5,0,11) I $P($G(^XWB(8994.5,Y,0)),"^",1)="CAPRIFHIE" "FIA",8994.5,0,"RLRO") "FIA",8994.5,0,"VR") 2.7^DVBA "FIA",8994.5,8994.5) 0 "FIA",8994.5,8994.51) 0 "FRV1",8994.5,"8,0",2) DVBA CAPRI GUI "FRV1",8994.5,"8,0",2,"F") ;DIC(19, "INIT") POST^DVBA143P "KRN",19,9510,-1) 0^1 "KRN",19,9510,0) DVBA CAPRI GUI^Capri GUI (Broker)^^B^^^^^^^^AUTOMATED MED INFO EXCHANGE^^1 "KRN",19,9510,1,0) ^19.06^2^2^3090521^^^^ "KRN",19,9510,1,1,0) This is the 'B' type option used by CAPRI GUI client application. It "KRN",19,9510,1,2,0) contains all the RPCs used by the CAPRI GUI application. "KRN",19,9510,20) "KRN",19,9510,25) "KRN",19,9510,99.1) 61634,56031 "KRN",19,9510,"RPC",0) ^19.05P^137^136 "KRN",19,9510,"RPC",1,0) DVBAB REPORT LISTS "KRN",19,9510,"RPC",2,0) DVBAB APPOINTMENT LIST "KRN",19,9510,"RPC",3,0) DVBAB CHECK CREDENTIALS "KRN",19,9510,"RPC",4,0) DVBAB FIND EXAMS "KRN",19,9510,"RPC",5,0) DVBAB PTINQ "KRN",19,9510,"RPC",6,0) DVBAB INCREASE EXAM COUNT "KRN",19,9510,"RPC",7,0) DVBAB SEND MSG "KRN",19,9510,"RPC",8,0) DVBAB REPORT CHECKLIST "KRN",19,9510,"RPC",9,0) DDR FILER "KRN",19,9510,"RPC",10,0) DDR LISTER "KRN",19,9510,"RPC",11,0) DDR VALIDATOR "KRN",19,9510,"RPC",12,0) DDR GETS ENTRY DATA "KRN",19,9510,"RPC",14,0) XWB GET VARIABLE VALUE "KRN",19,9510,"RPC",15,0) DVBAB HEALTH SUMMARY TEXT "KRN",19,9510,"RPC",16,0) TIU DOCUMENTS BY CONTEXT "KRN",19,9510,"RPC",17,0) TIU GET RECORD TEXT "KRN",19,9510,"RPC",18,0) ORQQCN LIST "KRN",19,9510,"RPC",19,0) ORQQCN DETAIL "KRN",19,9510,"RPC",20,0) DVBAB INST LIST "KRN",19,9510,"RPC",22,0) ORWRP REPORT TEXT "KRN",19,9510,"RPC",23,0) ORWORR AGET "KRN",19,9510,"RPC",24,0) ORWRA IMAGING EXAMS "KRN",19,9510,"RPC",25,0) ORWRP1 LISTNUTR "KRN",19,9510,"RPC",26,0) ORWMC PATIENT PROCEDURES "KRN",19,9510,"RPC",27,0) ORQQPL PROBLEM LIST "KRN",19,9510,"RPC",28,0) ORWORR GET4LST "KRN",19,9510,"RPC",29,0) ORWLR CUMULATIVE REPORT "KRN",19,9510,"RPC",32,0) DVBAB DATETIME "KRN",19,9510,"RPC",34,0) ORWPT ADMITLST "KRN",19,9510,"RPC",35,0) DVBAB SC VETERAN REPORT "KRN",19,9510,"RPC",36,0) ORQQVS VISITS/APPTS "KRN",19,9510,"RPC",37,0) ORWU DT "KRN",19,9510,"RPC",38,0) ORWLRR CHART "KRN",19,9510,"RPC",39,0) DG SENSITIVE RECORD ACCESS "KRN",19,9510,"RPC",40,0) DG SENSITIVE RECORD BULLETIN "KRN",19,9510,"RPC",41,0) DVBAB REPORT EXAM CHKLIST "KRN",19,9510,"RPC",42,0) DVBAB REPORT ADMINQ "KRN",19,9510,"RPC",43,0) DVBAB REPORT INCOMPVET "KRN",19,9510,"RPC",44,0) DVBAB REPORT DISCHARGE "KRN",19,9510,"RPC",45,0) DVBAB REPORT READMIT "KRN",19,9510,"RPC",46,0) DVBAB REPORT ADMISSIONS "KRN",19,9510,"RPC",47,0) DVBAB REPORT 7131INQ "KRN",19,9510,"RPC",48,0) DVBAB PENDING C&P REPORT "KRN",19,9510,"RPC",49,0) DVBAB REPORT CPDETAILS "KRN",19,9510,"RPC",50,0) DVBAB AMIS REPORT "KRN",19,9510,"RPC",51,0) DVBAB REPORT PENDING7131 "KRN",19,9510,"RPC",52,0) DVBAB LABLIST "KRN",19,9510,"RPC",53,0) DVBAB VERSION "KRN",19,9510,"RPC",54,0) DDR DELETE ENTRY "KRN",19,9510,"RPC",55,0) ORWRP REPORT LISTS "KRN",19,9510,"RPC",57,0) DVBAB DIVISION "KRN",19,9510,"RPC",58,0) DVBAB TEAM PATIENTS "KRN",19,9510,"RPC",59,0) ORWCIRN FACLIST "KRN",19,9510,"RPC",60,0) XWB REMOTE STATUS CHECK "KRN",19,9510,"RPC",61,0) XWB REMOTE GETDATA "KRN",19,9510,"RPC",63,0) ORWPT DIEDON "KRN",19,9510,"RPC",66,0) XWB REMOTE RPC "KRN",19,9510,"RPC",68,0) DDR FIND1 "KRN",19,9510,"RPC",69,0) DVBAB REPORTS "KRN",19,9510,"RPC",70,0) ORWRP2 COMPABV "KRN",19,9510,"RPC",71,0) DVBAB SURGERY CASE "KRN",19,9510,"RPC",72,0) ORWRP2 COMPDISP "KRN",19,9510,"RPC",73,0) ORWRP2 HS COMPONENTS "KRN",19,9510,"RPC",74,0) ORWRP2 HS COMPONENT SUBS "KRN",19,9510,"RPC",75,0) ORWRP2 HS COMP FILES "KRN",19,9510,"RPC",76,0) ORWRP2 SAVLKUP "KRN",19,9510,"RPC",77,0) ORWRP2 HS REPORT TEXT "KRN",19,9510,"RPC",78,0) ORWRP2 GETLKUP "KRN",19,9510,"RPC",79,0) ORWRP2 HS FILE LOOKUP "KRN",19,9510,"RPC",80,0) ORWRP2 HS SUBITEMS "KRN",19,9510,"RPC",81,0) DVBAB MAIL INIT "KRN",19,9510,"RPC",82,0) ORWLRR MICRO "KRN",19,9510,"RPC",83,0) TIU CREATE RECORD "KRN",19,9510,"RPC",84,0) DVBAB MPI ASSIGN ICN "KRN",19,9510,"RPC",85,0) TIU SIGN RECORD "KRN",19,9510,"RPC",86,0) TIU DELETE RECORD "KRN",19,9510,"RPC",87,0) TIU REQUIRES COSIGNATURE "KRN",19,9510,"RPC",88,0) DVBAB REPORT ADMISSION INQUIRY "KRN",19,9510,"RPC",89,0) DVBAB REPORT NEW NOTICES DC "KRN",19,9510,"RPC",90,0) DVBAB NOTE TITLES "KRN",19,9510,"RPC",91,0) DVBAB TEMPLATE DEFINITION "KRN",19,9510,"RPC",92,0) DDR FINDER "KRN",19,9510,"RPC",93,0) ORWCV VST "KRN",19,9510,"RPC",94,0) TIU LOAD BOILERPLATE TEXT "KRN",19,9510,"RPC",95,0) DVBAB GET VISIT INFO "KRN",19,9510,"RPC",96,0) DVBAB REPORT SPECIAL "KRN",19,9510,"RPC",97,0) DVBAB SAVE FORM "KRN",19,9510,"RPC",98,0) DVBAB EXAMS BY DATE "KRN",19,9510,"RPC",99,0) TIU GET SITE PARAMETERS "KRN",19,9510,"RPC",100,0) TIU GET ALERT INFO "KRN",19,9510,"RPC",101,0) ORWU VALIDSIG "KRN",19,9510,"RPC",103,0) ORWORB FASTUSER "KRN",19,9510,"RPC",104,0) DVBAB TEMPLATE LIST "KRN",19,9510,"RPC",105,0) DVBAB LOAD FORM "KRN",19,9510,"RPC",106,0) DVBAB TEMPLATE REPORT FULL "KRN",19,9510,"RPC",107,0) DVBAB FETCH 1U4N "KRN",19,9510,"RPC",108,0) DVBAB FORM DATA BACKUP DELETE "KRN",19,9510,"RPC",109,0) DVBAB FORM DATA BACKUP RESTORE "KRN",19,9510,"RPC",110,0) DDR LOCK/UNLOCK NODE "KRN",19,9510,"RPC",111,0) DVBAB FORM COPY "KRN",19,9510,"RPC",112,0) DVBAB FIND DUPS "KRN",19,9510,"RPC",113,0) DVBAB NEW PERSON FILE "KRN",19,9510,"RPC",114,0) DVBAB FORM DATA BACKUP "KRN",19,9510,"RPC",116,0) DVBAB SET DIVISION "KRN",19,9510,"RPC",117,0) DVBAB GET URL "KRN",19,9510,"RPC",118,0) ORPRF TRIGGER POPUP "KRN",19,9510,"RPC",119,0) ORPRF HASFLG "KRN",19,9510,"RPC",120,0) ORPRF HASCAT1 "KRN",19,9510,"RPC",121,0) ORPRF GETFLG "KRN",19,9510,"RPC",122,0) ORPRF CLEAR "KRN",19,9510,"RPC",123,0) TIU SET DOCUMENT TEXT "KRN",19,9510,"RPC",124,0) DVBAB ORIGINAL PROCESSING DATE "KRN",19,9510,"RPC",125,0) TIU CREATE ADDENDUM RECORD "KRN",19,9510,"RPC",126,0) TIU UPDATE RECORD "KRN",19,9510,"RPC",128,0) XUS SET VISITOR "KRN",19,9510,"RPC",129,0) XUS GET VISITOR "KRN",19,9510,"RPC",130,0) DVBAB RESTRICTED LIST PATIENTS "KRN",19,9510,"RPC",131,0) DVBAB DOD INFO "KRN",19,9510,"RPC",132,0) DVBAB DOD REPORT "KRN",19,9510,"RPC",133,0) DVBAB DOD REPORT TYPES "KRN",19,9510,"RPC",134,0) DVBAB FIND DFN BY ICN "KRN",19,9510,"RPC",135,0) DVBAB CCOW "KRN",19,9510,"RPC",136,0) DVBAB ZIP2CITY "KRN",19,9510,"RPC",137,0) DVBA CHECK PATCH "KRN",19,9510,"U") CAPRI GUI (BROKER) "KRN",8989.5,1561,0) 223;DIC(9.4,^DVBAB CAPRI MINIMUM VERSION^1 "KRN",8989.5,1561,1) CAPRI GUI V2.7*123*0*A "KRN",8989.5,1563,0) 223;DIC(9.4,^DVBAB CAPRI ALLOW OLD VERSION^1 "KRN",8989.5,1563,1) 0 "KRN",8989.5,1724,0) 223;DIC(9.4,^DVBAB CAPRI HIA UPDATE URL^1 "KRN",8989.5,1724,1) http://vaww.va.gov/hia/Downloads.htm "KRN",8989.51,491,-1) 0^3 "KRN",8989.51,491,0) DVBAB CAPRI MINIMUM VERSION^CAPRI minimum server version^0^^^0 "KRN",8989.51,491,1) F^^This is the current minimum CAPRI GUI version "KRN",8989.51,491,20,0) ^^2^2^3091008^ "KRN",8989.51,491,20,1,0) This parameter contains the minimum CAPRI GUI version that is compatible "KRN",8989.51,491,20,2,0) with the server version. Format: CAPRI GUIv2.7*123*1*A*NOOLD "KRN",8989.51,491,30,0) ^8989.513I^1^1 "KRN",8989.51,491,30,1,0) 1^9.4 "KRN",8989.51,492,-1) 0^1 "KRN",8989.51,492,0) DVBAB CAPRI ALLOW OLD VERSION^Allow old versions of CAPRI to run^0 "KRN",8989.51,492,1) Y^^Will versions older than the Minimum Version be allowed to run? "KRN",8989.51,492,30,0) ^8989.513I^1^1 "KRN",8989.51,492,30,1,0) 1^9.4 "KRN",8989.51,507,-1) 0^2 "KRN",8989.51,507,0) DVBAB CAPRI HIA UPDATE URL^HIA URL to obtain CAPRI software update:^0 "KRN",8989.51,507,1) F^^Enter the HIA URL that contains current CAPRI software "KRN",8989.51,507,20,0) ^^3^3^3091008^ "KRN",8989.51,507,20,1,0) This parameter contains the full URL that points to the Health "KRN",8989.51,507,20,2,0) Information Access download web site. The web site contains the latest "KRN",8989.51,507,20,3,0) released version of CAPRI. "KRN",8989.51,507,30,0) ^8989.513I^1^1 "KRN",8989.51,507,30,1,0) 1^9.4 "KRN",8994,2892,-1) 0^1 "KRN",8994,2892,0) DVBAB ZIP2CITY^ZIP2CITY^DVBABADR^2^S "KRN",8994,2892,1,0) ^^4^4^3090611^ "KRN",8994,2892,1,1,0) The remote procedure returns a list containing city, county, and state for "KRN",8994,2892,1,2,0) a given ZIP code. "KRN",8994,2892,1,3,0) Results format: Result(0)=ResultCount_"^"_ErrorMsg "KRN",8994,2892,1,4,0) Result(1..n)=City_"^"_County_"^"_State "KRN",8994,2892,2,0) ^8994.02A^1^1 "KRN",8994,2892,2,1,0) DVBZIP^1^12^1^1 "KRN",8994,2892,2,1,1,0) ^^1^1^3090611^ "KRN",8994,2892,2,1,1,1,0) ZIP code value in ZIP+4 format. "KRN",8994,2892,2,"B","DVBZIP",1) "KRN",8994,2892,2,"PARAMSEQ",1,1) "KRN",8994,2892,3,0) ^^3^3^3090611^ "KRN",8994,2892,3,1,0) RESULT(0)=ResultCount_"^"_ErrorMsg "KRN",8994,2892,3,2,0) RESULT(1)=City_"^"_County_"^"_State "KRN",8994,2892,3,3,0) RESULT(n)=City_"^"_County_"^"_State "KRN",8994,2916,-1) 0^2 "KRN",8994,2916,0) DVBA CHECK PATCH^CHECK^DVBAB1B^1^S "KRN",8994,2916,1,0) ^^3^3^3090930^ "KRN",8994,2916,1,1,0) This RPC is a wrapper for the supported $$PATCH^XPDUTL API to determine "KRN",8994,2916,1,2,0) whether a given patch is installed or not. "1^Patch Is Installed" is "KRN",8994,2916,1,3,0) returned on success; otherwise "0^Patch Is Not Installed" is returned. "KRN",8994,2916,2,0) ^8994.02A^1^1 "KRN",8994,2916,2,1,0) DVBPATCH^1^20^1^1 "KRN",8994,2916,2,1,1,0) ^^1^1^3090930^ "KRN",8994,2916,2,1,1,1,0) This parameter contains the patch designation (ex. DVBA*2.7*142). "KRN",8994,2916,2,"B","DVBPATCH",1) "KRN",8994,2916,2,"PARAMSEQ",1,1) "KRN",8994,2916,3,0) ^^2^2^3090930^ "KRN",8994,2916,3,1,0) Returns "1^Patch Is Installed" on success; otherwise returns "0^Patch Is "KRN",8994,2916,3,2,0) Not Installed". "MBREQ") 0 "ORD",16,8994) 8994;16;1;;;;;;;RPCDEL^XPDIA1 "ORD",16,8994,0) REMOTE PROCEDURE "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "ORD",20,8989.51) 8989.51;20;;;PAR1E1^XPDTA2;PAR1F1^XPDIA3;PAR1E1^XPDIA3;PAR1F2^XPDIA3;;PAR1DEL^XPDIA3(%) "ORD",20,8989.51,0) PARAMETER DEFINITION "PGL",8994.5,0,2,.02) CONTEXTOPTION^RP19'^DIC(19,^0;2^Q "PKG",223,-1) 1^1 "PKG",223,0) AUTOMATED MED INFO EXCHANGE^DVBA^The entire AMIE package 7131/2507. "PKG",223,20,0) ^9.402P^^ "PKG",223,22,0) ^9.49I^1^1 "PKG",223,22,1,0) 2.7^2950410^3010328 "PKG",223,22,1,"PAH",1,0) 143^3091022 "PKG",223,22,1,"PAH",1,1,0) ^^2^2^3091022 "PKG",223,22,1,"PAH",1,1,1,0) Please refer to patch DVBA*2.7*143 for a complete description of this "PKG",223,22,1,"PAH",1,1,2,0) patch. "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") NO "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") 9 "RTN","DVBA143P") 0^^B3638369^n/a "RTN","DVBA143P",1,0) DVBA143P ;ALB/RPM - PATCH DVBA*2.7*143 POST-INSTALL ;10/08/2009 "RTN","DVBA143P",2,0) ;;2.7;AMIE;**143**;Apr 10, 1995;Build 4 "RTN","DVBA143P",3,0) ; "RTN","DVBA143P",4,0) Q ;NO DIRECT ENTRY "RTN","DVBA143P",5,0) ; "RTN","DVBA143P",6,0) ENV ;Main entry point for Environment check point. "RTN","DVBA143P",7,0) ; "RTN","DVBA143P",8,0) Q "RTN","DVBA143P",9,0) ; "RTN","DVBA143P",10,0) ; "RTN","DVBA143P",11,0) PRE ;Main entry point for Pre-init items. "RTN","DVBA143P",12,0) ; "RTN","DVBA143P",13,0) Q "RTN","DVBA143P",14,0) ; "RTN","DVBA143P",15,0) ; "RTN","DVBA143P",16,0) POST ;Main entry point for Post-init items. "RTN","DVBA143P",17,0) ; "RTN","DVBA143P",18,0) N DVBERR "RTN","DVBA143P",19,0) D BMES^XPDUTL("*************************") "RTN","DVBA143P",20,0) D MES^XPDUTL("Start Parameter Updates") "RTN","DVBA143P",21,0) D MES^XPDUTL("*************************") "RTN","DVBA143P",22,0) ; "RTN","DVBA143P",23,0) S DVBERR=$$ENXPAR("PKG","DVBAB CAPRI ALLOW OLD VERSION","NO") "RTN","DVBA143P",24,0) D UPDMSG("DVBAB CAPRI ALLOW OLD VERSION",DVBERR) "RTN","DVBA143P",25,0) ; "RTN","DVBA143P",26,0) S DVBERR=$$ENXPAR("PKG","DVBAB CAPRI HIA UPDATE URL","http://vaww.va.gov/hia/Downloads.htm") "RTN","DVBA143P",27,0) D UPDMSG("DVBAB CAPRI HIA UPDATE URL",DVBERR) "RTN","DVBA143P",28,0) ; "RTN","DVBA143P",29,0) S DVBERR=$$ENXPAR("PKG","DVBAB CAPRI MINIMUM VERSION","CAPRI GUI V2.7*123*0*A") "RTN","DVBA143P",30,0) D UPDMSG("DVBAB CAPRI MINIMUM VERSION",DVBERR) "RTN","DVBA143P",31,0) ; "RTN","DVBA143P",32,0) D MES^XPDUTL("*************************") "RTN","DVBA143P",33,0) D MES^XPDUTL("End Parameter Updates") "RTN","DVBA143P",34,0) D MES^XPDUTL("*************************") "RTN","DVBA143P",35,0) Q "RTN","DVBA143P",36,0) ; "RTN","DVBA143P",37,0) ENXPAR(DVBENT,DVBPAR,DVBVAL) ;Update Parameter values "RTN","DVBA143P",38,0) ; "RTN","DVBA143P",39,0) ; Input: "RTN","DVBA143P",40,0) ; DVBENT - Parameter Entity "RTN","DVBA143P",41,0) ; DVBPAR - Parameter Name "RTN","DVBA143P",42,0) ; DVBVAL - Parameter Value "RTN","DVBA143P",43,0) ; "RTN","DVBA143P",44,0) ; Output: "RTN","DVBA143P",45,0) ; Function value - returns "0" on success; "RTN","DVBA143P",46,0) ; otherwise returns error#^errortext "RTN","DVBA143P",47,0) ; "RTN","DVBA143P",48,0) N DVBERR "RTN","DVBA143P",49,0) D EN^XPAR(DVBENT,DVBPAR,1,DVBVAL,.DVBERR) "RTN","DVBA143P",50,0) Q DVBERR "RTN","DVBA143P",51,0) ; "RTN","DVBA143P",52,0) UPDMSG(DVBPAR,DVBERR) ;display update message "RTN","DVBA143P",53,0) ; "RTN","DVBA143P",54,0) ; Input: "RTN","DVBA143P",55,0) ; DVBPAR - Parameter Name "RTN","DVBA143P",56,0) ; DVBERR - Parameter Update result "RTN","DVBA143P",57,0) ; "RTN","DVBA143P",58,0) ; Output: none "RTN","DVBA143P",59,0) ; "RTN","DVBA143P",60,0) I DVBERR D "RTN","DVBA143P",61,0) . D MES^XPDUTL(DVBPAR_" update FAILURE.") "RTN","DVBA143P",62,0) . D MES^XPDUTL(" Failure reason: "_DVBERR) "RTN","DVBA143P",63,0) E D "RTN","DVBA143P",64,0) . D MES^XPDUTL(DVBPAR_" update SUCCESS.") "RTN","DVBA143P",65,0) Q "RTN","DVBAB1") 0^6^B54842893^B54214482 "RTN","DVBAB1",1,0) DVBAB1 ;ALB/SPH - CAPRI UTILITIES ; 10/08/2009 "RTN","DVBAB1",2,0) ;;2.7;AMIE;**35,37,50,42,53,57,73,104,109,137,146,143**;Apr 10, 1995;Build 4 "RTN","DVBAB1",3,0) ; "RTN","DVBAB1",4,0) VERSION(ZMSG,DVBGUIV) ; "RTN","DVBAB1",5,0) ; "RTN","DVBAB1",6,0) ; --rpc: DVBAB VERSION "RTN","DVBAB1",7,0) ; "RTN","DVBAB1",8,0) ; Must have a letter at the end of the Version for Delphi compatibility. "RTN","DVBAB1",9,0) ; 1st piece is version description "RTN","DVBAB1",10,0) ; 2nd piece can be YESOLD or NOOLD "RTN","DVBAB1",11,0) ; YESOLD --> Allow old GUI to run with new KID "RTN","DVBAB1",12,0) ; NOOLD --> Do not allow old GUI to run with newer version "RTN","DVBAB1",13,0) ; "RTN","DVBAB1",14,0) ; Ex: "CAPRI GUI V2.7*123*0*A^NOOLD" "RTN","DVBAB1",15,0) ; "RTN","DVBAB1",16,0) ; Sets variables DVBABVR* so that the error trap will display what "RTN","DVBAB1",17,0) ; version of the client software the user was utilizing if CAPRI bombs. "RTN","DVBAB1",18,0) ; "RTN","DVBAB1",19,0) N DVBVERS "RTN","DVBAB1",20,0) N DVBOLD "RTN","DVBAB1",21,0) ; "RTN","DVBAB1",22,0) ;obtain version parameters and build version string result "RTN","DVBAB1",23,0) S DVBVERS=$$GET^XPAR("PKG","DVBAB CAPRI MINIMUM VERSION",1,"Q") "RTN","DVBAB1",24,0) S DVBOLD=$$GET^XPAR("PKG","DVBAB CAPRI ALLOW OLD VERSION",1,"Q") "RTN","DVBAB1",25,0) S ZMSG=DVBVERS_"^"_$S(DVBOLD=1:"YESOLD",1:"NOOLD") "RTN","DVBAB1",26,0) ; "RTN","DVBAB1",27,0) ;set DVBABVR* vars for error trap "RTN","DVBAB1",28,0) S DVBABVR1="CAPRI Server Version: "_ZMSG "RTN","DVBAB1",29,0) S DVBABVR2="CAPRI GUI Version: "_$S($G(DVBGUIV)]"":DVBGUIV,1:"UNKNOWN") "RTN","DVBAB1",30,0) S DVBABVR3=$P(^VA(200,DUZ,0),"^",1) "RTN","DVBAB1",31,0) Q "RTN","DVBAB1",32,0) ; "RTN","DVBAB1",33,0) REQUESTS(Y,TYPE) ; "RTN","DVBAB1",34,0) ; TYPE is the internal value of field 17 in file 396.3 "RTN","DVBAB1",35,0) ; This relates to which status of request should be returned "RTN","DVBAB1",36,0) N DVBABCNT,DVBABIEN "RTN","DVBAB1",37,0) S DVBABCNT=0,DVBABIEN=0 "RTN","DVBAB1",38,0) F S DVBABIEN=$O(^DVB(396.3,DVBABIEN)) Q:'DVBABIEN D "RTN","DVBAB1",39,0) .S DVBABST=$P($G(^DVB(396.3,DVBABIEN,0)),"^",18) "RTN","DVBAB1",40,0) .I DVBABST=TYPE D "RTN","DVBAB1",41,0) ..S DVBABNM=$P($G(^DVB(396.3,DVBABIEN,0)),"^",1) "RTN","DVBAB1",42,0) ..S DVBABPT=DVBABNM "RTN","DVBAB1",43,0) ..I DVBABNM'="" S DVBABNM=$P($G(^DPT(DVBABNM,0)),"^",1) "RTN","DVBAB1",44,0) ..S DVBABDT=$$FMTE^XLFDT($P($G(^DVB(396.3,DVBABIEN,0)),"^",2),"2D") "RTN","DVBAB1",45,0) ..S DVBABWHO=$P($G(^DVB(396.3,DVBABIEN,0)),"^",4) "RTN","DVBAB1",46,0) ..I DVBABWHO'="" S DVBABWHO=$P($G(^VA(200,DVBABWHO,0)),"^",1) "RTN","DVBAB1",47,0) ..E S DVBABWHO="UNKNOWN" "RTN","DVBAB1",48,0) ..S DVBABRO=$P($G(^DVB(396.3,DVBABIEN,0)),"^",3) "RTN","DVBAB1",49,0) ..I DVBABRO'="" S DVBABRO=$P($G(^DIC(4,DVBABRO,0)),"^",1) "RTN","DVBAB1",50,0) ..E S DVBABRO="UNKNOWN" "RTN","DVBAB1",51,0) ..S ^TMP("DVBAREQ",DUZ,DVBABCNT)=DVBABST_"^"_DVBABPT_"^"_DVBABNM_"^"_DVBABDT_"^"_DVBABWHO_"^"_DVBABRO_"^"_DVBABIEN_$C(13),DVBABCNT=DVBABCNT+1 "RTN","DVBAB1",52,0) S Y=$NA(^TMP("DVBAREQ",DUZ)) "RTN","DVBAB1",53,0) K DVBABCNT,DVBABIEN,TYPE,DVBABNM,DVBABDT,DVBABST,DVBABWHO,DVBABPT "RTN","DVBAB1",54,0) Q "RTN","DVBAB1",55,0) TEAMPTS(DVBORY,TEAM,TMPFLAG) ; RETURN LIST OF PATIENTS IN A TEAM "RTN","DVBAB1",56,0) ; If TMPFLAG passed and = TRUE, code expects a "^TMP(xxx" "RTN","DVBAB1",57,0) ; global root string passed in ORY, and builds the returned "RTN","DVBAB1",58,0) ; list in that global instead of to a memory array. "RTN","DVBAB1",59,0) N DOTMP,NEWTMP,DVBSSN,DVBORI,DVBORPT,I "RTN","DVBAB1",60,0) K ^TMP("DVBATMPT",DUZ) "RTN","DVBAB1",61,0) S (I,DOTMP,DVBORI)=0 "RTN","DVBAB1",62,0) I $G(TMPFLAG) D ; Was value passed? "RTN","DVBAB1",63,0) .I TMPFLAG S DOTMP=1 ; Is value TRUE? "RTN","DVBAB1",64,0) I +$G(TEAM)<1 D "RTN","DVBAB1",65,0) .I DOTMP S NEWTMP=DVBORY_1_")",@NEWTMP="^No team identified" "RTN","DVBAB1",66,0) .E S DVBORY(1)="^No team identified" "RTN","DVBAB1",67,0) F S DVBORI=$O(^OR(100.21,+TEAM,10,DVBORI)) Q:DVBORI<1 D "RTN","DVBAB1",68,0) .S DVBORPT=^OR(100.21,+TEAM,10,DVBORI,0) "RTN","DVBAB1",69,0) .I DOTMP D "RTN","DVBAB1",70,0) ..S I=I+1,NEWTMP=DVBORY_+I_")" "RTN","DVBAB1",71,0) ..S @NEWTMP=+DVBORPT_U_$P(^DPT(+DVBORPT,0),U) "RTN","DVBAB1",72,0) .S DVBSSN=$P($G(^DPT($P(DVBORPT,";",1),0)),U,9) "RTN","DVBAB1",73,0) .E S I=I+1,^TMP("DVBATMPT",DUZ,I)=+DVBORPT_U_$P(^DPT(+DVBORPT,0),U)_U_DVBSSN_$C(13) "RTN","DVBAB1",74,0) I DOTMP S:I<1 NEWTMP=DVBORY_1_")",@NEWTMP="^No patients found." "RTN","DVBAB1",75,0) E S:I<1 ^TMP("DVBATMPT",DUZ,1)="^No patients found." "RTN","DVBAB1",76,0) S DVBORY=$NA(^TMP("DVBATMPT",DUZ)) "RTN","DVBAB1",77,0) Q "RTN","DVBAB1",78,0) DIVISION(Y) ; Returns Name for an Institution "RTN","DVBAB1",79,0) N DVBARR,DVBERR,DVBATP "RTN","DVBAB1",80,0) S Y="" "RTN","DVBAB1",81,0) Q:$G(DUZ(2))="" "RTN","DVBAB1",82,0) D GETS^DIQ(4,DUZ(2)_",0",".01","I","DVBARR","DVBERR") "RTN","DVBAB1",83,0) Q:$D(DVBERR) "RTN","DVBAB1",84,0) S Y=$G(DVBARR(4,DUZ(2)_",0,",.01,"I")) "RTN","DVBAB1",85,0) D GETS^DIQ(4,DUZ(2)_",0",13,"I","DVBARR","DVBERR") "RTN","DVBAB1",86,0) S DVBATP=$G(DVBARR(4,DUZ(2)_",0,",13,"I")) "RTN","DVBAB1",87,0) I DVBATP'="" S DVBATP=$P($G(^DIC(4.1,DVBATP,0)),"^",1) "RTN","DVBAB1",88,0) S Y=Y_"-"_DVBATP "RTN","DVBAB1",89,0) Q "RTN","DVBAB1",90,0) ; "RTN","DVBAB1",91,0) DT(Y,X1,X2) ; Returns date X1 minus X2 days "RTN","DVBAB1",92,0) ; change the '00:00' that could be passed so Fileman doesn't reject "RTN","DVBAB1",93,0) ;C^%DTC(X1,X2) "RTN","DVBAB1",94,0) ;S %DT=$G(%DT,"TS") D ^%DT "RTN","DVBAB1",95,0) ;K %DT,X1,X2 "RTN","DVBAB1",96,0) ;Q "RTN","DVBAB1",97,0) DTTM(Y) ; "RTN","DVBAB1",98,0) S Y=$$HTE^XLFDT($H,"P") "RTN","DVBAB1",99,0) Q "RTN","DVBAB1",100,0) CHKCRED(Y) ;KLB "RTN","DVBAB1",101,0) S Y="[OK]" "RTN","DVBAB1",102,0) I '$D(DUZ(2)) S Y="Your division number is missing." Q "RTN","DVBAB1",103,0) I $D(DUZ)#2=0 S Y="Your user number is invalid." Q "RTN","DVBAB1",104,0) I +DUZ(2)<1 S Y="Invalid division." "RTN","DVBAB1",105,0) Q "RTN","DVBAB1",106,0) PTINQ(REF,DFN) ; Return formatted pt inquiry report "RTN","DVBAB1",107,0) K ^TMP("ORDATA",$J,1) "RTN","DVBAB1",108,0) ; DVBA*2.7*109 - Added $D to next line "RTN","DVBAB1",109,0) I ($D(^DPT(DFN,0))) D START^ORWRP(80,"DGINQB^ORCXPND1(DFN)") "RTN","DVBAB1",110,0) S REF=$NA(^TMP("ORDATA",$J,1)) "RTN","DVBAB1",111,0) Q "RTN","DVBAB1",112,0) TEMPLATE(Y) ; Returns list of CAPRI exam templates "RTN","DVBAB1",113,0) N DVBABCNT,DVBABIEN,DVBABNM,DVBABAD,DVBABDD,DVBABSL,DVBABOC "RTN","DVBAB1",114,0) K Y,^TMP("DVBALAB1",DUZ) "RTN","DVBAB1",115,0) S DVBABCNT=0,DVBABIEN=0 "RTN","DVBAB1",116,0) F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D "RTN","DVBAB1",117,0) .S DVBABNM=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1) "RTN","DVBAB1",118,0) .S DVBABAD=$P($G(^DVB(396.18,DVBABIEN,2)),"^",1) "RTN","DVBAB1",119,0) .S DVBABDD=$P($G(^DVB(396.18,DVBABIEN,2)),"^",2) "RTN","DVBAB1",120,0) .S DVBABSL=$P($G(^DVB(396.18,DVBABIEN,6)),"^",1) "RTN","DVBAB1",121,0) .S DVBABOC=$P($G(^DVB(396.18,DVBABIEN,6)),"^",2) "RTN","DVBAB1",122,0) .S ^TMP("DVBATMPL",DUZ,DVBABCNT)=DVBABNM_"^"_DVBABAD_"^"_DVBABDD_"^"_DVBABSL_"^"_DVBABOC_"^"_DVBABIEN_$C(13),DVBABCNT=DVBABCNT+1 "RTN","DVBAB1",123,0) S Y=$NA(^TMP("DVBATMPL",DUZ)) "RTN","DVBAB1",124,0) Q "RTN","DVBAB1",125,0) ; "RTN","DVBAB1",126,0) LABLIST(Y) ; Returns list of LAB TEST NAMES "RTN","DVBAB1",127,0) N DVBABCNT,DVBABIEN,DVBABLNM "RTN","DVBAB1",128,0) K Y,^TMP("DVBALAB1",DUZ) "RTN","DVBAB1",129,0) S DVBABCNT=0,DVBABIEN=0 "RTN","DVBAB1",130,0) F S DVBABIEN=$O(^LAB(60,DVBABIEN)) Q:'DVBABIEN D "RTN","DVBAB1",131,0) .S DVBABLNM=$P($G(^LAB(60,DVBABIEN,0)),"^",1) "RTN","DVBAB1",132,0) .S ^TMP("DVBALAB1",DUZ,DVBABCNT)=DVBABLNM_"^"_DVBABIEN_$C(13),DVBABCNT=DVBABCNT+1 "RTN","DVBAB1",133,0) S Y=$NA(^TMP("DVBALAB1",DUZ)) "RTN","DVBAB1",134,0) Q "RTN","DVBAB1",135,0) ; "RTN","DVBAB1",136,0) INSTLIST(Y) ; Returns full list of Institutions "RTN","DVBAB1",137,0) N DVBABCNT,DVBABIEN,DVBABNM,DVBABSTN,DVBABST,DVBABDS,DVBARR,DVBERR,DVBATP "RTN","DVBAB1",138,0) K Y,^TMP("DVBAINST",$J,DUZ) "RTN","DVBAB1",139,0) S (DVBABCNT,DVBABIEN)=0 "RTN","DVBAB1",140,0) F S DVBABIEN=$O(^DIC(4,DVBABIEN)) Q:'DVBABIEN D "RTN","DVBAB1",141,0) . K DVBARR,DVBERR "RTN","DVBAB1",142,0) . D GETS^DIQ(4,DVBABIEN_",0",".01:.02:.03:","I","DVBARR","DVBERR") "RTN","DVBAB1",143,0) . Q:$D(DVBERR) "RTN","DVBAB1",144,0) . S DVBABNM=$G(DVBARR(4,DVBABIEN_",0,",.01,"I")) "RTN","DVBAB1",145,0) . Q:DVBABNM="" "RTN","DVBAB1",146,0) . S DVBABSTN=$G(DVBARR(4,DVBABIEN_",0,",.02,"I")) "RTN","DVBAB1",147,0) . Q:DVBABSTN="" "RTN","DVBAB1",148,0) . S DVBABDS=$G(DVBARR(4,DVBABIEN_",0,",.03,"I")) "RTN","DVBAB1",149,0) . K DVBARR,DVBERR "RTN","DVBAB1",150,0) . D GETS^DIQ(5,DVBABSTN_",0",.01,"I","DVBARR","DVBERR") "RTN","DVBAB1",151,0) . Q:$D(DVBERR) "RTN","DVBAB1",152,0) . S DVBABST=$G(DVBARR(5,DVBABSTN_",0,",.01,"I")) "RTN","DVBAB1",153,0) . K DVBARR,DVBERR "RTN","DVBAB1",154,0) . D GETS^DIQ(4,DVBABIEN_",0",13,"I","DVBARR","DVBERR") "RTN","DVBAB1",155,0) . S DVBATP=$G(DVBARR(4,DVBABIEN_",0,",13,"I")) "RTN","DVBAB1",156,0) . I DVBATP'="" D "RTN","DVBAB1",157,0) .. S DVBATP=$P($G(^DIC(4.1,DVBATP,0)),"^",1) "RTN","DVBAB1",158,0) . S ^TMP("DVBAINST",$J,DUZ,DVBABCNT)=DVBABNM_"-"_DVBATP_"^"_DVBABST_"^"_DVBABDS_"^"_DVBABIEN_$C(13) "RTN","DVBAB1",159,0) . S DVBABCNT=DVBABCNT+1 "RTN","DVBAB1",160,0) S Y=$NA(^TMP("DVBAINST",$J,DUZ)) "RTN","DVBAB1",161,0) Q "RTN","DVBAB1",162,0) ; "RTN","DVBAB1",163,0) INCEXAM(ZMSG) ;Increased exam # in file and passes back the # to user "RTN","DVBAB1",164,0) S ZMSG=+$G(^DVB(396.1,1,5))+1 "RTN","DVBAB1",165,0) S ^DVB(396.1,1,5)=ZMSG "RTN","DVBAB1",166,0) Q "RTN","DVBAB1",167,0) ; "RTN","DVBAB1",168,0) MSG(ERR,DUZ,XMSUB,XMTEXT,MGN) ;Generate mail message;KLB "RTN","DVBAB1",169,0) ; --rpc: DVBAB SEND MSG "RTN","DVBAB1",170,0) ; "RTN","DVBAB1",171,0) ; This remote procedure is used to generate bulletins for specific CAPRI actions, such as cancellation of 2507 exams. "RTN","DVBAB1",172,0) ; "RTN","DVBAB1",173,0) ; Supported References: "RTN","DVBAB1",174,0) ; DBIA #10111: Allows FM read access of ^XMB(3.8,D0,0) using DIC. "RTN","DVBAB1",175,0) K ^TMP($J,"AMIE") "RTN","DVBAB1",176,0) S XMB="" "RTN","DVBAB1",177,0) I '$D(DUZ) S ERR="MISSING DUZ" Q "RTN","DVBAB1",178,0) I '$D(XMSUB) S ERR="MISSING SUBJECT" Q "RTN","DVBAB1",179,0) I '$D(XMTEXT) S ERR="MISSING TEXT" Q "RTN","DVBAB1",180,0) I '$D(MGN) S ERR="MISSING MAIL GROUP NAME" Q "RTN","DVBAB1",181,0) S XMDUZ=DUZ,J=0 "RTN","DVBAB1",182,0) F S J=$O(XMTEXT(J)) Q:'J S ^TMP($J,"AMIE",J)=$G(XMTEXT(J)) "RTN","DVBAB1",183,0) S XMTEXT="^TMP($J,""AMIE""," "RTN","DVBAB1",184,0) S DIC="^XMB(3.8,",DIC(0)="QM",X=MGN D ^DIC "RTN","DVBAB1",185,0) I +Y<0 S ERR="INVALID MAIL GROUP NAME" Q "RTN","DVBAB1",186,0) I '$$GOTLOCAL^XMXAPIG(MGN) S ERR="NO ACTIVE LOCAL MEMBERS IN MAIL GROUP" K ^TMP("XMERR",$J) Q "RTN","DVBAB1",187,0) I MGN="DVBA C NEW C&P VETERAN" S XMB="DVBA CAPRI NEW C&P VETERAN" "RTN","DVBAB1",188,0) I MGN="DVBA C 2507 CANCELLATION" S XMB="DVBA CAPRI 2507 CANCELLATION" "RTN","DVBAB1",189,0) I XMB="" S ERR="UNABLE TO SET BULLETIN" Q "RTN","DVBAB1",190,0) D ^XMB "RTN","DVBAB1",191,0) ;XMB = -1 if bulletin not found in file (#3.6) "RTN","DVBAB1",192,0) S ERR=$S(XMB=-1:"BULLETIN NOT FOUND",1:"MESSAGE SENT") "RTN","DVBAB1",193,0) K XMSUB,XMTEXT,MGN,DIC,DIC(0),J,Y,XMDUZ,XMB "RTN","DVBAB1",194,0) Q "RTN","DVBAB1",195,0) FINDEXAM(ZMSG,ZIEN) ;Returns list of exams in 396.4 that are linked to ZIEN in 396.3 "RTN","DVBAB1",196,0) N DVBABCNT,DVBABIEN "RTN","DVBAB1",197,0) S DVBABCNT=0,DVBABIEN=0 "RTN","DVBAB1",198,0) F S DVBABIEN=$O(^DVB(396.4,"C",ZIEN,DVBABIEN)) Q:'DVBABIEN D "RTN","DVBAB1",199,0) .S DVBABD1=$P($G(^DVB(396.4,DVBABIEN,0)),"^",2) "RTN","DVBAB1",200,0) .S DVBABD2=$P($G(^DVB(396.6,+$P($G(^DVB(396.4,DVBABIEN,0)),"^",3),0)),"^",1) ;Name of Exam "RTN","DVBAB1",201,0) .S DVBABD3=$P($G(^DVB(396.4,DVBABIEN,0)),"^",4) "RTN","DVBAB1",202,0) .I DVBABD3="O" S DVBABD3="[OPEN]" "RTN","DVBAB1",203,0) .I DVBABD3="C" S DVBABD3="[COMPLETE]" "RTN","DVBAB1",204,0) .I DVBABD3="X" S DVBABD3="[CANCELED BY MAS]" "RTN","DVBAB1",205,0) .I DVBABD3="RX" S DVBABD3="[CANCELED BY RO]" "RTN","DVBAB1",206,0) .I DVBABD3="T" S DVBABD3="[TRANSFERRED OUT]" "RTN","DVBAB1",207,0) .I ZIEN=DVBABD1 D "RTN","DVBAB1",208,0) ..S ZMSG(DVBABCNT)=DVBABIEN_"^"_DVBABD2_" "_DVBABD3 "RTN","DVBAB1",209,0) ..S DVBABCNT=DVBABCNT+1 "RTN","DVBAB1",210,0) K DVBABCNT,DVBABIEN,ZIEN,DVBABD1,DVBABD2,DVBABD3 "RTN","DVBAB1",211,0) Q "RTN","DVBAB1B") 0^7^B11312167^B10372670 "RTN","DVBAB1B",1,0) DVBAB1B ;ALB/SPH - CAPRI UTILITIES ;09/30/2009 "RTN","DVBAB1B",2,0) ;;2.7;AMIE;**104,143**;Apr 10, 1995;Build 4 "RTN","DVBAB1B",3,0) ; "RTN","DVBAB1B",4,0) DPA(LIST,DFN,CHOICE) ;Display Patient Appointments "RTN","DVBAB1B",5,0) N DVBABCNT,CKCHOICE "RTN","DVBAB1B",6,0) S LIST="",DVBABCNT=1,CKCHOICE="A,F,P",DFN=$G(DFN),CHOICE=$G(CHOICE) K ^TMP("DVBAAPPT",$J) "RTN","DVBAB1B",7,0) I DFN="" S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="MISSING PATIENT NAME",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ)) Q "RTN","DVBAB1B",8,0) I CHOICE="" S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="MISSING ALL, PAST, OR FUTURE",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ)) Q "RTN","DVBAB1B",9,0) I CKCHOICE'[CHOICE S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="INVALID SELECTION",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ)) Q "RTN","DVBAB1B",10,0) I CHOICE["A" D "RTN","DVBAB1B",11,0) .S SDT=0 "RTN","DVBAB1B",12,0) .S X="T+730" D ^%DT "RTN","DVBAB1B",13,0) .I Y<0 S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="ERROR IN CALCULATING ENDING DATE RANGE",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ)) "RTN","DVBAB1B",14,0) .S EDT=Y+.9 "RTN","DVBAB1B",15,0) I CHOICE["F" D "RTN","DVBAB1B",16,0) .S X="T+1" D ^%DT "RTN","DVBAB1B",17,0) .I Y<0 S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="ERROR IN CALCULATING START DATE RANGE",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ)) "RTN","DVBAB1B",18,0) .S SDT=Y "RTN","DVBAB1B",19,0) .K X,Y "RTN","DVBAB1B",20,0) .S X="T+730" D ^%DT "RTN","DVBAB1B",21,0) .I Y<0 S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="ERROR IN CALCULATING ENDING DATE RANGE",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ)) "RTN","DVBAB1B",22,0) .S EDT=Y+.9 "RTN","DVBAB1B",23,0) I CHOICE["P" D "RTN","DVBAB1B",24,0) .S X="T" D ^%DT "RTN","DVBAB1B",25,0) .I Y<0 S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="ERROR IN CALCULATING ENDING DATE RANGE",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ)) "RTN","DVBAB1B",26,0) .S EDT=Y+.9 "RTN","DVBAB1B",27,0) .K X,Y "RTN","DVBAB1B",28,0) .S SDT=0 "RTN","DVBAB1B",29,0) Q:LIST["ERROR" "RTN","DVBAB1B",30,0) I $O(^DPT(DFN,"S",SDT))'>0 S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="NO APPOINTMENTS FOUND FOR YOUR DATE RANGE",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ)) Q "RTN","DVBAB1B",31,0) F S SDT=$O(^DPT(DFN,"S",SDT)) Q:'SDT!(SDT>EDT) D "RTN","DVBAB1B",32,0) .S CLN=$P(^DPT(DFN,"S",SDT,0),"^") Q:'CLN "RTN","DVBAB1B",33,0) .Q:'$D(^SC(CLN,0)) "RTN","DVBAB1B",34,0) .S CLN=$P(^SC(CLN,0),"^") "RTN","DVBAB1B",35,0) .S ZZ=$L(CLN) "RTN","DVBAB1B",36,0) .I ZZ<31 D "RTN","DVBAB1B",37,0) ..F ZZZ=ZZ:1:30 S CLN=CLN_" " "RTN","DVBAB1B",38,0) .S Y=SDT X ^DD("DD") "RTN","DVBAB1B",39,0) .S ZZ2=$L(Y) "RTN","DVBAB1B",40,0) .I ZZ2<21 D "RTN","DVBAB1B",41,0) ..F ZZZ2=ZZ2:1:20 S Y=Y_" " "RTN","DVBAB1B",42,0) .S STATUS=$P(^DPT(DFN,"S",SDT,0),"^",2) "RTN","DVBAB1B",43,0) .I STATUS'="" D "RTN","DVBAB1B",44,0) ..I STATUS="N" S STATUS="NO-SHOW" "RTN","DVBAB1B",45,0) ..I STATUS="C" S STATUS="CANCELLED BY CLINIC" "RTN","DVBAB1B",46,0) ..I STATUS="CA" S STATUS="CANCELLED BY CLINIC & AUTO RE-BOOK" "RTN","DVBAB1B",47,0) ..I STATUS="NA" S STATUS="NO-SHOW & AUTO-REBOOK" "RTN","DVBAB1B",48,0) ..I STATUS="I" S STATUS="INPATIENT APPOINTMENT" "RTN","DVBAB1B",49,0) ..I STATUS="PC" S STATUS="CANCELLED BY PATIENT" "RTN","DVBAB1B",50,0) ..I STATUS="PCA" S STATUS="CANCELLED BY PATIENT & AUTO RE-BOOK" "RTN","DVBAB1B",51,0) ..I STATUS="NT" S STATUS="NO ACTION TAKEN" "RTN","DVBAB1B",52,0) . I $D(^DPT(DFN,"S",SDT,"R")) S REMARK=$P(^DPT(DFN,"S",SDT,"R"),"^",1) ;ADDED "RTN","DVBAB1B",53,0) .S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)=CLN_" "_Y_" "_STATUS,DVBABCNT=DVBABCNT+1 "RTN","DVBAB1B",54,0) . I $D(REMARK) S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)=" Cancellation Remarks: "_REMARK,DVBABCNT=DVBABCNT+1 "RTN","DVBAB1B",55,0) . I $D(REMARK) K REMARK "RTN","DVBAB1B",56,0) .S LIST=$NA(^TMP("DVBAAPPT",$J,DUZ)) "RTN","DVBAB1B",57,0) K DFN,X,%DT,CLN,CHOICE,Y,SDT,EDT "RTN","DVBAB1B",58,0) Q "RTN","DVBAB1B",59,0) ; "RTN","DVBAB1B",60,0) CHECK(DVBRSLTS,DVBPATCH) ; Checks for KIDS Patch install "RTN","DVBAB1B",61,0) ; RPC: DVBA CHECK PATCH "RTN","DVBAB1B",62,0) ; Input: DVBPATCH - Patch Number (i.e. DVBA*2.7*142) "RTN","DVBAB1B",63,0) ; Output: Returns "1^Patch Is Installed" on success; "RTN","DVBAB1B",64,0) ; otherwise returns "0^Patch Is Not Installed" "RTN","DVBAB1B",65,0) N DVBX "RTN","DVBAB1B",66,0) S DVBX=$$PATCH^XPDUTL(DVBPATCH) "RTN","DVBAB1B",67,0) S DVBRSLTS=$S(DVBX:"1^Patch Is Installed",1:"0^Patch Is Not Installed") "RTN","DVBAB1B",68,0) Q "RTN","DVBAB70") 0^2^B43310973^B39041842 "RTN","DVBAB70",1,0) DVBAB70 ;ALB/SPH - CAPRI C&P EXAM INQUIRY ;09/28/2009 "RTN","DVBAB70",2,0) ;;2.7;AMIE;**35,42,57,136,143**;Apr 10, 1995;Build 4 "RTN","DVBAB70",3,0) ; "RTN","DVBAB70",4,0) STRT(ZMSG,DFN,ZREQDA) ; "RTN","DVBAB70",5,0) S DVBABCNT=0 "RTN","DVBAB70",6,0) K ^TMP($J) S Y=DT X ^DD("DD") S FDT(0)=Y D HOME^%ZIS S FF=IOF "RTN","DVBAB70",7,0) S DIC="^DVB(396.3," "RTN","DVBAB70",8,0) S DIC(0)="M" "RTN","DVBAB70",9,0) S DIC(1)=ZREQDA "RTN","DVBAB70",10,0) S Y=ZREQDA "RTN","DVBAB70",11,0) S JI=$P(Y,U,2),(DA,DA(1),REQDA)=+Y "RTN","DVBAB70",12,0) S (NAME,SSN,CNUM,ADR1,ADR2,ADR3,CITY,STATE,ZIP,HOMPHON,BUSPHON,OTHDIS)="" "RTN","DVBAB70",13,0) S (COUNTY,PROVINCE,POSTALCD,COUNTRY)="" "RTN","DVBAB70",14,0) D VARS^DVBCUTIL "RTN","DVBAB70",15,0) G START "RTN","DVBAB70",16,0) CON ; "RTN","DVBAB70",17,0) I IOST?1"P-".E,$Y>45 W @IOF D HDR "RTN","DVBAB70",18,0) Q "RTN","DVBAB70",19,0) START S PGHD="",PG=0 "RTN","DVBAB70",20,0) S ZMSG(DVBABCNT)=" COMPENSATION AND PENSION EXAM INQUIRY",DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",21,0) S ZMSG(DVBABCNT)=" -------------------------------------",DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",22,0) S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",23,0) S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",24,0) S ZMSG(DVBABCNT)=" Name: "_PNAM,DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",25,0) S ZMSG(DVBABCNT)=" SSN: "_SSN,DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",26,0) S ZMSG(DVBABCNT)=" C-Number: "_CNUM,DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",27,0) S Y=DOB X ^DD("DD") "RTN","DVBAB70",28,0) S ZMSG(DVBABCNT)=" DOB: "_Y,DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",29,0) S ZMSG(DVBABCNT)=" Address: "_ADR1,DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",30,0) I ADR2'="" S ZMSG(DVBABCNT)=" "_ADR2,DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",31,0) I ADR3'="" S ZMSG(DVBABCNT)=" "_ADR3,DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",32,0) I $$ISFORGN^DVBCUTIL(COUNTRY)>0 D "RTN","DVBAB70",33,0) . S ZMSG(DVBABCNT)="City,Province,Postal Code: "_CITY_", "_PROVINCE_" "_POSTALCD "RTN","DVBAB70",34,0) . S DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",35,0) E D "RTN","DVBAB70",36,0) . S ZMSG(DVBABCNT)=" City,State,Zip+4: "_CITY_", "_STATE_" "_ZIP "RTN","DVBAB70",37,0) . S DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",38,0) I COUNTRY>0 D "RTN","DVBAB70",39,0) . S ZMSG(DVBABCNT)=" Country: "_$$GETCNTRY^DVBCUTIL(COUNTRY) "RTN","DVBAB70",40,0) . S DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",41,0) S ZMSG(DVBABCNT)=" Res Phone: "_HOMPHON,DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",42,0) S ZMSG(DVBABCNT)=" Bus Phone: "_BUSPHON,DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",43,0) S EDTA=$S($D(^DPT(DFN,.32)):^(.32),1:""),EOD=$P(EDTA,U,6),RAD=$P(EDTA,U,7) "RTN","DVBAB70",44,0) S Y=EOD X ^DD("DD") S:Y="" Y="Not specified" "RTN","DVBAB70",45,0) S ZMSG(DVBABCNT)=" Entered active service: "_Y,DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",46,0) S Y=RAD X ^DD("DD") S:Y="" Y="Not specified" "RTN","DVBAB70",47,0) S ZMSG(DVBABCNT)=" Released active service: "_Y,DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",48,0) S ZMSG(DVBABCNT)="================================================================================",DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",49,0) W !! D CON Q:$D(OUT) D ^DVBAB97,CON Q:$D(OUT) D ^DVBAB68,CON Q:$D(OUT) S REQDT=$P(^DVB(396.3,REQDA,0),U,2) "RTN","DVBAB70",50,0) S Y=REQDT X ^DD("DD") "RTN","DVBAB70",51,0) S ZMSG(DVBABCNT)="This request was initiated on "_$P(Y,"@",1)_" at "_$P(Y,"@",2),DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",52,0) S ZMSG(DVBABCNT)="Requester: "_REQN,DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",53,0) S ZMSG(DVBABCNT)="Requesting Regional Office: "_RONAME,DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",54,0) S ZMSG(DVBABCNT)="VHA Division Processing Request: "_$P($$SITE^VASITE(,$P(^DVB(396.3,REQDA,1),U,4)),U,2),DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",55,0) S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",56,0) I $D(^DVB(396.4,"C",REQDA)) S ZMSG(DVBABCNT)="Exams on this request: ",DVBABCNT=DVBABCNT+1 D TST^DVBAB96 ;DVBCUTL2 "RTN","DVBAB70",57,0) I '$D(^DVB(396.4,"C",REQDA)) S ZMSG(DVBABCNT)="(No exams have yet been entered)",DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",58,0) S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",59,0) S ZMSG(DVBABCNT)="** Status of request: ",DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",60,0) S (XSTAT,STAT)=$P(^DVB(396.3,REQDA,0),U,18) "RTN","DVBAB70",61,0) S STAT=$S(XSTAT="N":"New",XSTAT="P":"Pending, reported to MAS",XSTAT="T":"Transcribed",XSTAT="S":"Scheduled",XSTAT="R":"Released, not printed",XSTAT="C":"Completed",XSTAT="CT":"Completed, transferred out",XSTAT="NT":"New, transferred in",1:"") "RTN","DVBAB70",62,0) I STAT]"" S ZMSG(DVBABCNT)=STAT,DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",63,0) I XSTAT="R"!(XSTAT="C") S Y=$P(^DVB(396.3,REQDA,0),U,14) X ^DD("DD") S RELBY=$P(^DVB(396.3,REQDA,0),U,15),RELBY=$S($D(^VA(200,+RELBY,0)):$P(^(0),U,1),1:"Unknown user") S ZMSG(DVBABCNT)="Released on "_Y_" by "_RELBY,DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",64,0) I XSTAT="C" S Y=$P(^DVB(396.3,REQDA,0),U,16) X ^DD("DD") S PRBY=$P(^DVB(396.3,REQDA,0),U,17),PRBY=$S($D(^VA(200,+PRBY,0)):$P(^(0),U,1),1:"Unknown user") S ZMSG(DVBABCNT)="Printed by the RO on "_Y_" by "_PRBY,DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",65,0) I STAT="" S STAT=$S(XSTAT="X":"Cancelled by MAS",XSTAT="RX":"Cancelled by RO",1:"Unknown") S ZMSG(DVBABCNT)=STAT,DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",66,0) I STAT["Cancelled" S CANDT=$P(^DVB(396.3,REQDA,0),U,19) S ZMSG(DVBABCNT)=" (Cancelled on "_$$FMTE^XLFDT(CANDT,"5DZ")_")",DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",67,0) I $D(^DVB(396.3,REQDA,1)),$P(^(1),U,3)="Y" S ZMSG(DVBABCNT)="This request was faxed to the regional office.",DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",68,0) S FEXAM=$P(^DVB(396.3,REQDA,0),U,9) I FEXAM="Y" S ZMSG(DVBABCNT)="*** Exams done on a FEE BASIS *** ",DVBABCNT=DVBABCNT+1 K FEXAM "RTN","DVBAB70",69,0) S ZMSG(DVBABCNT)="--------------------------------------------------------------------------------",DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",70,0) D DDIS Q:$D(OUT) D CON Q:$D(OUT) "RTN","DVBAB70",71,0) I IOST?1"P-".E,$Y>45 W @IOF D HDR "RTN","DVBAB70",72,0) S ZMSG(DVBABCNT)="Other Disabilities: "_OTHDIS,DVBABCNT=DVBABCNT+1 I $D(^DVB(396.3,REQDA,1)) S ZMSG(DVBABCNT)=" "_OTHDIS1,DVBABCNT=DVBABCNT+1 S ZMSG(DVBABCNT)=" "_OTHDIS2,DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",73,0) S ZMSG(DVBABCNT)="General Remarks:",DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",74,0) K ^UTILITY($J,"W") "RTN","DVBAB70",75,0) F LINE=0:0 S LINE=$O(^DVB(396.3,REQDA,2,LINE)) Q:LINE="" S X=^(LINE,0),DIWL=5,DIWR=75,DIWF=$S(X["|":"NWX",1:"NW") D ^DIWP S ZMSG(DVBABCNT)=X,DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",76,0) END K ^TMP($J),TSTA1,TSTAT,XCNP "RTN","DVBAB70",77,0) Q "RTN","DVBAB70",78,0) DDIS1 S ZMSG(DVBABCNT)=DX_" "_$J(PCT,3,0)_" %",DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",79,0) S ZMSG(DVBABCNT)=" Service-Connected? "_$S(SC=1:"Yes",1:"No")_" DX Code: "_DXCOD,DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",80,0) I $Y>19 D CON "RTN","DVBAB70",81,0) Q "RTN","DVBAB70",82,0) DDIS I $Y>12 D CON Q:$D(OUT) "RTN","DVBAB70",83,0) I '$D(^DPT(DFN,.372)) S ZMSG(DVBABCNT)="No rated disabilities on file",DVBABCNT=DVBABCNT+1 Q "RTN","DVBAB70",84,0) S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",85,0) S ZMSG(DVBABCNT)="RATED DISABILITIES:",DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",86,0) F JII=0:0 S JII=$O(^DPT(DFN,.372,JII)) Q:JII="" S DXNUM=$P(^DPT(DFN,.372,JII,0),U,1),PCT=$P(^(0),U,2),SC=$P(^(0),U,3),DX=$S($D(^DIC(31,DXNUM)):$P(^(DXNUM,0),U,1),1:"Unknown"),DXCOD=$S($D(^DIC(31,DXNUM)):$P(^(DXNUM,0),U,3),1:"Unknown") D DDIS1 "RTN","DVBAB70",87,0) S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",88,0) Q "RTN","DVBAB70",89,0) HDR S PG=PG+1 W:(IOST?1"C-".E) @IOF "RTN","DVBAB70",90,0) S ZMSG(DVBABCNT)="================================================================================",DVBABCNT=DVBABCNT+1 "RTN","DVBAB70",91,0) Q "RTN","DVBAB84") 0^5^B36589384^B36589482 "RTN","DVBAB84",1,0) DVBAB84 ;ALB/DK - CAPRI REMOTE NEW PERSON FILE ;09/28/09 "RTN","DVBAB84",2,0) ;;2.7;AMIE;**90,137,140,143**;Apr 10, 1995;Build 4 "RTN","DVBAB84",3,0) ; "RTN","DVBAB84",4,0) START(MSG) ;RPC DVBAB NEW PERSON FILE "RTN","DVBAB84",5,0) K ^TMP("DVBAB200",$J) "RTN","DVBAB84",6,0) N DATA,VAR,VAR1,DVBDIV,DVBDIVN,DVBRPT,CNT "RTN","DVBAB84",7,0) S DATA="",CNT=0,MSG=$NA(^TMP("DVBAB200",$J)) "RTN","DVBAB84",8,0) F S DATA=$O(^VA(200,"B",DATA)) Q:DATA="" D "RTN","DVBAB84",9,0) . S VAR="" "RTN","DVBAB84",10,0) . F S VAR=$O(^VA(200,"B",DATA,VAR)) Q:VAR="" D "RTN","DVBAB84",11,0) . . D GETS^DIQ(200,VAR_",",".01","E","DVBRPT") "RTN","DVBAB84",12,0) . . I $P($G(^VA(200,VAR,2,0)),"^",3)'="" D Q "RTN","DVBAB84",13,0) . . . S VAR1="" "RTN","DVBAB84",14,0) . . . F S VAR1=$O(^VA(200,VAR,2,"B",VAR1)) Q:VAR1="" D "RTN","DVBAB84",15,0) . . . . S DVBDIV=$$GET1^DIQ(200.02,VAR1_","_VAR_",",.01,"I") "RTN","DVBAB84",16,0) . . . . S DVBDIVN=$$GET1^DIQ(200.02,VAR1_","_VAR_",",.01,"E") "RTN","DVBAB84",17,0) . . . . S ^TMP("DVBAB200",$J,CNT)=VAR_"^"_DVBRPT(200,VAR_",",.01,"E")_"^"_DVBDIV_"^"_DVBDIVN_$C(13) "RTN","DVBAB84",18,0) . . . . S CNT=CNT+1 "RTN","DVBAB84",19,0) . . S ^TMP("DVBAB200",$J,CNT)=VAR_"^"_DVBRPT(200,VAR_",",.01,"E")_"^"_"^"_$C(13) "RTN","DVBAB84",20,0) . . S CNT=CNT+1 "RTN","DVBAB84",21,0) Q "RTN","DVBAB84",22,0) DUZ2(Y,NUM) ;RPC DVBAB SET DUZ2 "RTN","DVBAB84",23,0) N X,Z S NUM=$G(NUM),Y=1,X="0^STATION NUMBER " "RTN","DVBAB84",24,0) I NUM="" S Y=X_"IS REQUIRED" "RTN","DVBAB84",25,0) I '$D(^DIC(4,"D",NUM))&Y S Y=X_"DOES NOT EXIST" "RTN","DVBAB84",26,0) Q:'Y S Y=$O(^DIC(4,"D",NUM,"")),Z="" "RTN","DVBAB84",27,0) S:Y]"" Z=$G(^DIC(4,Y,0)) "RTN","DVBAB84",28,0) I Y=""!(Z="") S Y=X_"HAS A BAD X-REF" Q "RTN","DVBAB84",29,0) S DUZ(2)=Y,Y=Y_U_$P(Z,U) "RTN","DVBAB84",30,0) Q "RTN","DVBAB84",31,0) DUP(Y,NAM,DOB,SSN) ;RPC DVBAB FIND DUPS "RTN","DVBAB84",32,0) N E,C,N,D,S,A,B,M S B=" - Must be ",M=B_"at least 1 argument" "RTN","DVBAB84",33,0) S NAM=$$N0($G(NAM)),DOB=$P($G(DOB),"."),SSN=$$U($G(SSN)) "RTN","DVBAB84",34,0) S (C,N,D,S)=0,E="-1^Invalid Argument: ",Y=$NA(^TMP("DVBDUP",$J,DUZ)) K @Y "RTN","DVBAB84",35,0) I '$L(NAM_DOB_SSN) S C=E_"None Passed"_M "RTN","DVBAB84",36,0) S:'C&DOB&'$L(NAM_SSN) C=E_$P(M," ",3,8)_" passed with DOB" "RTN","DVBAB84",37,0) S:'C N=$$VN(NAM) I N S C=E_"NAM"_B_"LAST,FIRST or IEN" "RTN","DVBAB84",38,0) S:'C D=$$VD(DOB) I D S C=E_"DOB"_B_"FileMan format" "RTN","DVBAB84",39,0) S:'C S=$$VS(SSN) I S>0 S C=E_"SSN"_B_"9 digits, 1U4N format, or P (for pseudo-SSN)" "RTN","DVBAB84",40,0) I C S @Y@(0)=C Q "RTN","DVBAB84",41,0) S:S<0 SSN=$$S(NAM,DOB) "RTN","DVBAB84",42,0) D DN(.N,NAM),DD(.D,DOB,NAM,SSN),DS(.S,SSN,NAM,DOB),WT(Y,.A,.N,.D,.S) "RTN","DVBAB84",43,0) Q "RTN","DVBAB84",44,0) DN(A,N) I N=""!A S A=0 Q ;Dup Name checks "RTN","DVBAB84",45,0) N K,M S A=0,M=$$N2(N),K=$$N1(M)_"zzzzzzzzzz" "RTN","DVBAB84",46,0) F S K=$O(^DPT("B",K)) Q:$$N2(K)'=M D:$$M("N",K,N,,,5) D0(.A,"B",K) "RTN","DVBAB84",47,0) Q "RTN","DVBAB84",48,0) DD(A,D,N,S) I A!'D S A=0 Q ;Dup DOB checks "RTN","DVBAB84",49,0) N K,M,F S A=0,M=$E(D,1,5),K=M-1_99 "RTN","DVBAB84",50,0) F S K=$O(^DPT("ADOB",K)) Q:$E(K,1,5)'=M D "RTN","DVBAB84",51,0) .S F=0 I N]"",$$M("DN",K,N,D,,7) S F=1 "RTN","DVBAB84",52,0) .I 'F,S]"",$$M("DS",K,,D,S,7) S F=1 "RTN","DVBAB84",53,0) .D:F D0(.A,"ADOB",K) "RTN","DVBAB84",54,0) Q "RTN","DVBAB84",55,0) DS(A,S,N,D) N F,K,M,X,R,P I A!'S S A=0 Q ;Dup SSN checks "RTN","DVBAB84",56,0) S A=0,P=$L(S),R=P-4,M=$E(S,1,R),K=M-1_9999,X=$S(P=5:"BS5",1:"SSN") "RTN","DVBAB84",57,0) F S K=$O(^DPT(X,K)) Q:$E(K,1,R)'=M D "RTN","DVBAB84",58,0) .S F=$$M("S",K,,,S,P) I F D D0(.A,X,K) Q "RTN","DVBAB84",59,0) .Q:N=""&'D Q:'$$FF(S,K) "RTN","DVBAB84",60,0) .I D,$$MD(K,D,1) D D0(.A,X,K,3,D) Q "RTN","DVBAB84",61,0) .I N]"",$$MN(K,N,1) D D0(.A,X,K,1,N) "RTN","DVBAB84",62,0) Q "RTN","DVBAB84",63,0) D0(A,X,Y,P,V) N I,C,Z S I="",C="N D S",P=$G(P),V=$G(V) "RTN","DVBAB84",64,0) F S I=$O(^DPT(X,Y,I)) Q:'I D "RTN","DVBAB84",65,0) .S Z=$G(^DPT(I,0)) Q:Z="" "RTN","DVBAB84",66,0) .I P,'$$M($E(C,P),$P(Z,U,P),V,V,V,5) Q "RTN","DVBAB84",67,0) .S A=A+1,A(I)=Z "RTN","DVBAB84",68,0) Q "RTN","DVBAB84",69,0) VN(X) Q:X="" 0 Q X'?2.U1","1.U ;Validate Name "RTN","DVBAB84",70,0) VD(X) Q:X="" 0 Q:X'?7N 1 N M,D S M=$E(X,4,5),D=$E(X,6,7) ;Validate DOB "RTN","DVBAB84",71,0) Q:M<1!(M>12)!(D<0) 1 Q (D>$$D(M,$E(X,1,3))) "RTN","DVBAB84",72,0) VS(X) Q:X="" 0 Q:$E(X,$L(X))="P" -1 N L S L=$L(X) ;Validate SSN "RTN","DVBAB84",73,0) Q:L=5&(X'?1A4N)!(L=9&(X'?9N))!(L<5)!(L>9) 1 "RTN","DVBAB84",74,0) Q:$E(X,1,5)="00000" 0 ;Test Patient "RTN","DVBAB84",75,0) Q $E(X,1)=9!($E(X,1,3)="000") ;Can't begin with 9 or 000 "RTN","DVBAB84",76,0) MN(X,N,F) S F=$G(F)_U_($$N2(X,2)=$$N2(N,2)) Q:'F $P(F,U,2) Q $$N2(X)=$$N2(N) ;Match Name "RTN","DVBAB84",77,0) MD(X,D,F) S F=$G(F)_U_($E(X,4,5)=$E(D,4,5)) Q:'F $P(F,U,2) Q $E(X,1,3)=$E(D,1,3) ;Match DOB "RTN","DVBAB84",78,0) MS(X,S) N I,K S K=0,X=$$L4(X),S=$$L4(S) ;Match SSN "RTN","DVBAB84",79,0) F I=1:1:4 S K=$E(X,I)=$E(S,I)+K "RTN","DVBAB84",80,0) Q:K>1 1 ;2 nums, same spot "RTN","DVBAB84",81,0) Q $$S4(X)=$$S4(S) ;ALL 4 nums, any spot "RTN","DVBAB84",82,0) M(Y,X,N,D,S,L) N A,B,C,Z S (A,B,C)=0,Z=$L(X),L=+$G(L) Q:Z7&(M#2))) "RTN","DVBAB84",136,0) L(Y) Q Y#100!('(Y#400)&'(Y#4)) "RTN","DVBAB84",137,0) C(X) S X=$A($E(X,1))-65\3+1 Q:X<0 0 Q X "RTN","DVBAB84",138,0) P(X,C,L) N I,Y,Z S Z="",Y=X,C=$G(C,U),L=$G(L,$L(Y)) "RTN","DVBAB84",139,0) F I=1:1:$L(Y) Q:$L(Z)=L S X=$E(Y,I) S:X?1U!(C[X) Z=Z_X "RTN","DVBAB84",140,0) Q Z "RTN","DVBAB84",141,0) S(N,D) N L1,L2,L3 S:$G(D)="" D=2000000 ;PSEU^DGRPDD1 "RTN","DVBAB84",142,0) S L3=$$C(N),L1=$$C($P(N," ",2)),L2=$$C($P(N,",",2)) "RTN","DVBAB84",143,0) Q L2_L1_L3_$E(D,4,7)_$E(D,2,3)_"P" "RTN","DVBAB84",144,0) A(X) Q $S(X<0:X*-1,1:X) "RTN","DVBAB84",145,0) FF(X,Y) N I,K S X=$$L4(X),Y=$$L4(Y),K=0 "RTN","DVBAB84",146,0) F I=1:1:4 S:$$A($E(X,I)-$E(Y,I))<2 K=K+1 "RTN","DVBAB84",147,0) Q K>2 "RTN","DVBAB84",148,0) S4(X) N I,J,K,L,M S L=$L(X) "RTN","DVBAB84",149,0) F I=2:1:L S J=I,K=$E(X,I) D "RTN","DVBAB84",150,0) .F Q:J=1 S M=$E(X,J-1) Q:M'>K S $E(X,J)=M,J=J-1 "RTN","DVBAB84",151,0) .S $E(X,J)=K "RTN","DVBAB84",152,0) Q X "RTN","DVBABADR") 0^4^B1913888^n/a "RTN","DVBABADR",1,0) DVBABADR ;ALB/RPM - CAPRI ADDRESS UTILITIES ; 06/11/2009 "RTN","DVBABADR",2,0) ;;2.7;AMIE;**143**;Apr 10, 1995;Build 4 "RTN","DVBABADR",3,0) ; "RTN","DVBABADR",4,0) Q ;NO DIRECT ENTRY "RTN","DVBABADR",5,0) ; "RTN","DVBABADR",6,0) ZIP2CITY(RESULT,DVBZIP) ;return city/state list for a given zip code "RTN","DVBABADR",7,0) ;RPC: DVBAB ZIP2CITY "RTN","DVBABADR",8,0) ; "RTN","DVBABADR",9,0) N DVBCITY "RTN","DVBABADR",10,0) N DVBI "RTN","DVBABADR",11,0) D POSTALB^XIPUTIL(DVBZIP,.DVBCITY) "RTN","DVBABADR",12,0) S DVBI=0 "RTN","DVBABADR",13,0) S RESULT(0)=DVBCITY_U_$G(DVBCITY("ERROR")) "RTN","DVBABADR",14,0) F S DVBI=$O(DVBCITY(DVBI)) Q:'DVBI D "RTN","DVBABADR",15,0) . N DVBCNTYP "RTN","DVBABADR",16,0) . S DVBCNTYP=$$GETCNTYP($G(DVBCITY(DVBI,"COUNTY")),$G(DVBCITY(DVBI,"STATE POINTER"))) "RTN","DVBABADR",17,0) . S RESULT(DVBI)=$G(DVBCITY(DVBI,"CITY"))_U_$G(DVBCITY(DVBI,"COUNTY"))_U_DVBCNTYP_U_$G(DVBCITY(DVBI,"STATE"))_U_$G(DVBCITY(DVBI,"STATE POINTER")) "RTN","DVBABADR",18,0) Q "RTN","DVBABADR",19,0) ; "RTN","DVBABADR",20,0) GETCNTYP(DVBCNTY,DVBSTATE) ; "RTN","DVBABADR",21,0) N DVBRSLT "RTN","DVBABADR",22,0) S DVBRSLT=$$FIND1^DIC(5.01,","_DVBSTATE_",","X",DVBCNTY) "RTN","DVBABADR",23,0) Q $S(DVBRSLT>0:DVBRSLT,1:"") "RTN","DVBABURL") 0^8^B2354419^B2101434 "RTN","DVBABURL",1,0) DVBABURL ;ALB/SPH - CAPRI URL ;10/08/2009 "RTN","DVBABURL",2,0) ;;2.7;AMIE;**104,136,143**;Apr 10, 1995;Build 4 "RTN","DVBABURL",3,0) ; "RTN","DVBABURL",4,0) URL(Y,WHICH) ; "RTN","DVBABURL",5,0) S Y="" "RTN","DVBABURL",6,0) ; 1=VBA's AMIE Worksheet Website "RTN","DVBABURL",7,0) ; 2=CAPRI training website "RTN","DVBABURL",8,0) ; 3=VistAWeb website "RTN","DVBABURL",9,0) ; 5=HIA download website "RTN","DVBABURL",10,0) ; 999=Debug/Test Code "RTN","DVBABURL",11,0) I WHICH=1 S Y="http://152.124.238.193/bl/21/rating/Medical/exams/index.htm" "RTN","DVBABURL",12,0) I WHICH=2 S Y="http://vaww.cpep.med.va.gov/capri/" "RTN","DVBABURL",13,0) I WHICH=3 D "RTN","DVBABURL",14,0) . I '$$PROD^XUPROD S Y="-1^VistAWeb disabled for non-production systems." Q "RTN","DVBABURL",15,0) . S Y="https://vistaweb.med.va.gov/CapriPage.aspx" "RTN","DVBABURL",16,0) I WHICH=4 S Y="M21-1, Part VI, Rating Board Procedures^http://152.124.238.193/bl/21/Publicat/Manuals/Part6/601.htm#Exam" "RTN","DVBABURL",17,0) I WHICH=5 S Y=$$GET^XPAR("PKG","DVBAB CAPRI HIA UPDATE URL",1,"Q") "RTN","DVBABURL",18,0) I WHICH=999 S Y="http://vhaannweb2.v11.med.va.gov/VwDesktop/CapriPage.aspx" "RTN","DVBABURL",19,0) Q "RTN","DVBABURL",20,0) ; "RTN","DVBCENQ1") 0^3^B27476723^B24327636 "RTN","DVBCENQ1",1,0) DVBCENQ1 ;ALB/GTS,557/THM - 2507 INQUIRY DISPLAY ; 10/14/2009 1:00 PM "RTN","DVBCENQ1",2,0) ;;2.7;AMIE;**17,57,143**;Apr 10, 1995;Build 4 "RTN","DVBCENQ1",3,0) ; "RTN","DVBCENQ1",4,0) G START "RTN","DVBCENQ1",5,0) CON K OUT I IOST?1"C-".E W !,"Press [RETURN] to continue or ""^"" to stop " R ANS:DTIME S:ANS=U!('$T) OUT=1 Q:$D(OUT) D HDR "RTN","DVBCENQ1",6,0) I IOST?1"P-".E,$Y>45 W @IOF D HDR "RTN","DVBCENQ1",7,0) Q "RTN","DVBCENQ1",8,0) ; "RTN","DVBCENQ1",9,0) START S PGHD="COMPENSATION AND PENSION EXAM INQUIRY",PG=0 "RTN","DVBCENQ1",10,0) D HDR "RTN","DVBCENQ1",11,0) W !?2,"Name: ",PNAM,?56,"SSN: ",SSN "RTN","DVBCENQ1",12,0) W !?51,"C-Number: ",CNUM "RTN","DVBCENQ1",13,0) W !?56,"DOB: " S Y=DOB X ^DD("DD") W Y "RTN","DVBCENQ1",14,0) W !?4,"Address: ",ADR1 "RTN","DVBCENQ1",15,0) W ! W:ADR2]"" ?13,ADR2 "RTN","DVBCENQ1",16,0) W ! W:ADR3]"" ?13,ADR3 "RTN","DVBCENQ1",17,0) W !!?7,"City: ",CITY "RTN","DVBCENQ1",18,0) I $$ISFORGN^DVBCUTIL(COUNTRY) D "RTN","DVBCENQ1",19,0) . W !?3,"Province: ",PROVINCE,?48,"Res Phone: ",HOMPHON "RTN","DVBCENQ1",20,0) . W !,"Postal Code: ",POSTALCD,?48,"Bus Phone: ",BUSPHON "RTN","DVBCENQ1",21,0) E D "RTN","DVBCENQ1",22,0) . W !?6,"State: ",STATE,?48,"Res Phone: ",HOMPHON "RTN","DVBCENQ1",23,0) . W !?6,"Zip+4: ",ZIP,?48,"Bus Phone: ",BUSPHON "RTN","DVBCENQ1",24,0) I COUNTRY>0 D "RTN","DVBCENQ1",25,0) . W !?4,"Country: ",$$GETCNTRY^DVBCUTIL(COUNTRY),! "RTN","DVBCENQ1",26,0) E D "RTN","DVBCENQ1",27,0) . W ! "RTN","DVBCENQ1",28,0) S EDTA=$S($D(^DPT(DFN,.32)):^(.32),1:""),EOD=$P(EDTA,U,6),RAD=$P(EDTA,U,7) "RTN","DVBCENQ1",29,0) W !,"Entered active service: " S Y=EOD X ^DD("DD") S:Y="" Y="Not specified" W Y,! S Y=RAD X ^DD("DD") S:Y="" Y="Not specified" W "Released active service: " W Y,! "RTN","DVBCENQ1",30,0) F LINE=1:1:80 W "=" "RTN","DVBCENQ1",31,0) W !! D CON Q:$D(OUT) D ^DVBCENQ2,CON Q:$D(OUT) D ^DVBCEEXM,CON Q:$D(OUT) S REQDT=$P(^DVB(396.3,REQDA,0),U,2) "RTN","DVBCENQ1",32,0) W !,"This request was initiated on " S Y=REQDT X ^DD("DD") W $P(Y,"@",1)," at ",$P(Y,"@",2),!!?17,"Requester: ",REQN,!,"Requesting Regional Office: ",RONAME,! "RTN","DVBCENQ1",33,0) W "VHA Division Processing Request: "_$P($$SITE^VASITE(,$P(^DVB(396.3,REQDA,1),U,4)),U,2),! "RTN","DVBCENQ1",34,0) I $D(^DVB(396.4,"C",REQDA)) W !?3,"Exams on this request: " D TST^DVBCUTL2 W ! "RTN","DVBCENQ1",35,0) I '$D(^DVB(396.4,"C",REQDA)) W !?3,"(No exams have yet been entered)",! "RTN","DVBCENQ1",36,0) W !,"** Status of request: " S (XSTAT,STAT)=$P(^DVB(396.3,REQDA,0),U,18) "RTN","DVBCENQ1",37,0) S STAT=$S(XSTAT="N":"New",XSTAT="P":"Pending, reported to MAS",XSTAT="T":"Transcribed",XSTAT="S":"Scheduled",XSTAT="R":"Released, not printed",XSTAT="C":"Completed",XSTAT="CT":"Completed, transferred out",XSTAT="NT":"New, transferred in",1:"") "RTN","DVBCENQ1",38,0) I STAT]"" W STAT "RTN","DVBCENQ1",39,0) I XSTAT="R"!(XSTAT="C") W !!?9,"Released on " S Y=$P(^DVB(396.3,REQDA,0),U,14) X ^DD("DD") W Y," by " S RELBY=$P(^DVB(396.3,REQDA,0),U,15),RELBY=$S($D(^VA(200,+RELBY,0)):$P(^(0),U,1),1:"Unknown user") W RELBY,! "RTN","DVBCENQ1",40,0) I XSTAT="C" W "Printed by the RO on " S Y=$P(^DVB(396.3,REQDA,0),U,16) X ^DD("DD") W Y," by " S PRBY=$P(^DVB(396.3,REQDA,0),U,17),PRBY=$S($D(^VA(200,+PRBY,0)):$P(^(0),U,1),1:"Unknown user") W PRBY,! "RTN","DVBCENQ1",41,0) I STAT="" S STAT=$S(XSTAT="X":"Cancelled by MAS",XSTAT="RX":"Cancelled by RO",1:"Unknown") W STAT I STAT["Cancelled" W " (Cancelled on " S CANDT=$P(^DVB(396.3,REQDA,0),U,19) W $$FMTE^XLFDT(CANDT,"5DZ"),")" "RTN","DVBCENQ1",42,0) ;S X=$S($D(^DVB(396.3,REQDA,4)):$P(^(4),U,1),1:"") I X="y" W !,"Exam(s) transferred to another site -- see pending report.",! "RTN","DVBCENQ1",43,0) I $D(^DVB(396.3,REQDA,1)),$P(^(1),U,3)="Y" W !,"This request was faxed to the regional office.",! "RTN","DVBCENQ1",44,0) S FEXAM=$P(^DVB(396.3,REQDA,0),U,9) I FEXAM="Y" W !!,"*** Exams done on a FEE BASIS *** ",! K FEXAM "RTN","DVBCENQ1",45,0) W ! F LINE=1:1:79 W "-" "RTN","DVBCENQ1",46,0) W ! D DDIS Q:$D(OUT) D CON Q:$D(OUT) "RTN","DVBCENQ1",47,0) I IOST?1"P-".E,$Y>45 W @IOF D HDR "RTN","DVBCENQ1",48,0) W !!,"Other Disabilities:",!!?2,OTHDIS,! I $D(^DVB(396.3,REQDA,1)) W ?2,OTHDIS1,!?2,OTHDIS2 "RTN","DVBCENQ1",49,0) W !!,"General Remarks:",!! "RTN","DVBCENQ1",50,0) K ^UTILITY($J,"W") "RTN","DVBCENQ1",51,0) F LINE=0:0 S LINE=$O(^DVB(396.3,REQDA,2,LINE)) Q:LINE="" S X=^(LINE,0),DIWL=5,DIWR=75,DIWF="NW" D ^DIWP I IOST?1"C-".E,$Y>19 D CON W !!,"General Remarks, continued",!!! "RTN","DVBCENQ1",52,0) D ^DIWW "RTN","DVBCENQ1",53,0) END K ANS I IOST?1"C-".E W !!,"Press [RETURN] to continue or ""^"" to stop " R ANS:DTIME S:'$T!(ANS=U) OUT=1 I $D(OUT) Q:OUT=1 "RTN","DVBCENQ1",54,0) Q "RTN","DVBCENQ1",55,0) ; "RTN","DVBCENQ1",56,0) DDIS1 W ?2,DX,?37,$J(PCT,3,0)," %",?50,$S(SC=1:"Yes",1:"No"),?58,DXCOD,! "RTN","DVBCENQ1",57,0) I $Y>19 D CON "RTN","DVBCENQ1",58,0) Q "RTN","DVBCENQ1",59,0) ; "RTN","DVBCENQ1",60,0) DDIS I $Y>12 D CON Q:$D(OUT) "RTN","DVBCENQ1",61,0) I '$D(^DPT(DFN,.372)) W !?25,"No rated disabilities on file",!! Q "RTN","DVBCENQ1",62,0) W !?2,"Rated Disability",?37,"Percent",?50,"SC ?",?58,"Dx Code",! W ?2 F LINE=1:1:63 W "-" "RTN","DVBCENQ1",63,0) W !! "RTN","DVBCENQ1",64,0) F JII=0:0 S JII=$O(^DPT(DFN,.372,JII)) Q:JII="" S DXNUM=$P(^DPT(DFN,.372,JII,0),U,1),PCT=$P(^(0),U,2),SC=$P(^(0),U,3),DX=$S($D(^DIC(31,DXNUM)):$P(^(DXNUM,0),U,1),1:"Unknown"),DXCOD=$S($D(^DIC(31,DXNUM)):$P(^(DXNUM,0),U,3),1:"Unknown") D DDIS1 "RTN","DVBCENQ1",65,0) W !! "RTN","DVBCENQ1",66,0) Q "RTN","DVBCENQ1",67,0) ; "RTN","DVBCENQ1",68,0) HDR S PG=PG+1 W:(IOST?1"C-".E) @IOF "RTN","DVBCENQ1",69,0) W !,"Date: ",FDT(0),?(80-$L(PGHD)\2),PGHD,?71,"Page: ",PG W !,?(80-$L($$SITE^DVBCUTL4)\2),$$SITE^DVBCUTL4 I PG>1 W !!,"Name: ",PNAM,?44,"SSN: ",SSN,?63,"C-NUM: ",CNUM "RTN","DVBCENQ1",70,0) W ! F XLINE=1:1:80 W "=" "RTN","DVBCENQ1",71,0) W ! Q "RTN","DVBCUTIL") 0^1^B33092099^B27818943 "RTN","DVBCUTIL",1,0) DVBCUTIL ;ALB/GTS-557/THM;C&P UTILITY ROUTINE ; 9/28/2009 11:16 AM "RTN","DVBCUTIL",2,0) ;;2.7;AMIE;**17,126,143**;Apr 10, 1995;Build 4 "RTN","DVBCUTIL",3,0) ; "RTN","DVBCUTIL",4,0) KILL ;common exit "RTN","DVBCUTIL",5,0) D ^%ZISC I $D(FF),'$D(ZTQUEUED) W @FF,!! "RTN","DVBCUTIL",6,0) K %DT,ADR1,ADR2,ADR3,BDTRQ,BUSPHON,CITY,CNDCT,CNUM,DFN,DIW,DIWF,DIWL,DIWR,DIWT,DN,DOB,DTA,DTRQ,DX,DXCOD,DXNUM,EDTRQ,HOMPHON,I,LINE,MDTRM,NAME,OTHDIS,PCT,PG,PGHD,POP,PRINT,REQN,RO,ROHD,RONAME,RQ,SC,D,DIE,ONE,DVBCNEW,LN,FEXM,PRIO,DTB "RTN","DVBCUTIL",7,0) K SEX,SSN,STATE,TST,X,Y,Z,JI,JII,ZIP,JJ,KJX,D0,D1,DA,DI,DIC,DIPGM,DLAYGO,DQ,DWLW,HD,HD1,HD2,J,ONFILE,CTIM,JJ,C,DIZ,DPTSZ,STAT,JDT,JY,TSTDT,DIYS,EXAM,DR,REQDT,ELIG,INCMP,PRDSV,WARD,ADD1,ADD2,CNTY,PG,OLDDA,DIRUT,DUOUT "RTN","DVBCUTIL",8,0) K DVBCCNT,TNAM,DIR,TEMP,SWITCH,EDTA,RAD,EOD,%T,STATUS,XX,XDD,OLDA,OLDA1 "RTN","DVBCUTIL",9,0) K DTTRNSC,ZIP4,DVBAINSF,DTT,TAD1,TAD2,TAD3,TCITY,TST,TZIP,TPHONE "RTN","DVBCUTIL",10,0) K COUNTY,PROVINCE,POSTALCD,COUNTRY "RTN","DVBCUTIL",11,0) G KILL^DVBCUTL2 "RTN","DVBCUTIL",12,0) ; "RTN","DVBCUTIL",13,0) DICW ;used on ^DIC lookups only "RTN","DVBCUTIL",14,0) W ! S TSTDT=$P(^(0),U,2),RO=$P(^(0),U,3),STAT=$P(^(0),U,18),RONAME=$S($D(^DIC(4,+RO,0)):$P(^(0),U,1),1:"Unknown RO") D DICW1 "RTN","DVBCUTIL",15,0) W ! Q "RTN","DVBCUTIL",16,0) ; "RTN","DVBCUTIL",17,0) DICW1 F JY=0:0 S JY=$O(^DVB(396.4,"C",+Y,JY)) Q:JY="" S EXAM=$P(^DVB(396.4,+JY,0),U,3),EXAM=$S($D(^DVB(396.6,EXAM,0)):$P(^(0),U,1),1:"Unknown exam") D DICW2 "RTN","DVBCUTIL",18,0) Q "RTN","DVBCUTIL",19,0) ; "RTN","DVBCUTIL",20,0) DICW2 W ?3,EXAM," (",$$FMTE^XLFDT(TSTDT,"5DZ")," by ",RONAME,")",! "RTN","DVBCUTIL",21,0) Q "RTN","DVBCUTIL",22,0) ; "RTN","DVBCUTIL",23,0) VARS S DTA=^DVB(396.3,DA,0),DFN=$P(DTA,U,1),(NAME,PNAM)=$P(^DPT(DFN,0),U,1),DOB=$P(^(0),U,3),SEX=$P(^(0),U,2),SSN=$P(^(0),U,9),CNUM=$S($D(^DPT(DFN,.31)):$P(^(.31),U,3),1:"Unknown"),DTRQ=$P(DTA,U,2) "RTN","DVBCUTIL",24,0) S RO=$P(DTA,U,3),FEXM=$P(DTA,U,9) S:RO="" RO=0 S RONAME=$S($D(^DIC(4,RO,0)):$P(^(0),U,1),1:"Unknown") "RTN","DVBCUTIL",25,0) S REQN=$P(DTA,U,4),REQN=$S($D(^VA(200,+REQN,0)):$P(^(0),U,1),1:"Unknown"),OTHDIS=$P(DTA,U,11) I $D(^DVB(396.3,DA,1)) S OTHDIS1=$P(^(1),U,9),OTHDIS2=$P(^(1),U,10) "RTN","DVBCUTIL",26,0) S ZPR=$P(DTA,U,10),PRIO=$S(ZPR="T":"Terminal",ZPR="P":"Prisoner of war",ZPR="OS":"Original SC",ZPR="ON":"Original NSC",ZPR="I":"Increase",ZPR="R":"Review",ZPR="OTR":"Other",ZPR="E":"Inadequate exam",1:"Unknown") "RTN","DVBCUTIL",27,0) K DVBAINSF S:ZPR="E" DVBAINSF="" "RTN","DVBCUTIL",28,0) S (ADR1,ADR2,ADR3,CITY,STATE,ZIP)="" "RTN","DVBCUTIL",29,0) I $D(^DPT(DFN,.11)) D "RTN","DVBCUTIL",30,0) .S DTA=^DPT(DFN,.11) "RTN","DVBCUTIL",31,0) .S ADR1=$P(DTA,U,1),ADR2=$P(DTA,U,2),ADR3=$P(DTA,U,3),CITY=$P(DTA,U,4) "RTN","DVBCUTIL",32,0) .S ZIP=$P(DTA,U,12) S:ZIP'="" ZIP=$S($L(ZIP)>5:$E(ZIP,1,5)_"-"_$E(ZIP,6,9),1:ZIP) I ZIP="" S ZIP="No Zip" "RTN","DVBCUTIL",33,0) .S CITY=$S(CITY]"":CITY,1:"Unknown") S STATE=$P(DTA,U,5) I STATE]"" S STATE=$S($D(^DIC(5,STATE,0)):$P(^(0),U,1),1:"Unknown") "RTN","DVBCUTIL",34,0) .S (HOMPHON,BUSPHON)="Unknown" I $D(^DPT(DFN,.13)) S HOMPHON=$P(^(.13),U,1),BUSPHON=$P(^(.13),U,2) "RTN","DVBCUTIL",35,0) .S COUNTY=$P(DTA,U,7),PROVINCE=$P(DTA,U,8),POSTALCD=$P(DTA,U,9) "RTN","DVBCUTIL",36,0) .S COUNTRY=$P(DTA,U,10) "RTN","DVBCUTIL",37,0) I $D(^DPT(DFN,.121)) D ;DVBA/126 added "RTN","DVBCUTIL",38,0) .S (DTT,TAD1,TAD2,TAD3,TCITY,TST,TZIP,TPHONE)="" "RTN","DVBCUTIL",39,0) .S DTT=^DPT(DFN,.121) "RTN","DVBCUTIL",40,0) .S TAD1=$P(DTT,U,1),TAD2=$P(DTT,U,2),TAD3=$P(DTT,U,3),TCITY=$P(DTT,U,4) "RTN","DVBCUTIL",41,0) .S TZIP=$P(DTT,U,12) S:TZIP'="" TZIP=$S($L(TZIP)>5:$E(TZIP,1,5)_"-"_$E(TZIP,6,9),1:TZIP) I TZIP="" S TZIP="No Zip" "RTN","DVBCUTIL",42,0) .S TCITY=$S(TCITY]"":TCITY,1:"Unknown") S TST=$P(DTT,U,5) I TST]"" S TST=$S($D(^DIC(5,TST,0)):$P(^(0),U,1),1:"Unknown") "RTN","DVBCUTIL",43,0) .S TPHONE=$P(DTT,U,10) S:TPHONE="" TPHONE="Unknown" "RTN","DVBCUTIL",44,0) S EDTA=$S($D(^DPT(DFN,.32)):^(.32),1:""),EOD=$P(EDTA,U,6),RAD=$P(EDTA,U,7),Y=$S($D(^DVB(396.3,DA,1)):$P(^(1),U,7),1:"") X ^DD("DD") S LREXMDT=Y "RTN","DVBCUTIL",45,0) Q "RTN","DVBCUTIL",46,0) ; "RTN","DVBCUTIL",47,0) HDR W @FF,?(IOM-$L(HD2)\2),HD2,!!!?5,"Veteran name: ",PNAM,?45,"SSN: ",SSN,!?40,"C-NUMBER: ",CNUM,!!,"Exams on this request:",!! "RTN","DVBCUTIL",48,0) S JII="" "RTN","DVBCUTIL",49,0) F JIJ=0:0 S JII=$O(^TMP($J,JII)) Q:JII="" S XST=$P(^TMP($J,JII),U,1) W JII,", ",$S(XST="C":"Completed",XST="RX":"Cancelled by RO",XST="X":"Cancelled by MAS",XST="T":"Transferred",1:"Open"),", " I $X>30 W ! "RTN","DVBCUTIL",50,0) Q "RTN","DVBCUTIL",51,0) ; "RTN","DVBCUTIL",52,0) ADDR S (ADD1,ADD2,CITY,CNTY,STATE,ZIP)="" "RTN","DVBCUTIL",53,0) I $D(^DPT(DFN,.11)) S DTA=^(.11),ADD1=$P(DTA,U,1),ADD2=$P(DTA,U,2),CITY=$P(DTA,U,4),STATE=$P(DTA,U,5),ZIP=$P(DTA,U,12),CNTY=$P(DTA,U,7) "RTN","DVBCUTIL",54,0) S:ZIP'="" ZIP=$S($L(ZIP)>5:$E(ZIP,1,5)_"-"_$E(ZIP,6,9),1:ZIP) "RTN","DVBCUTIL",55,0) S CNTY=$S($D(^DIC(5,+STATE,1,+CNTY,0)):$P(^(0),U,1),1:"Unknown") "RTN","DVBCUTIL",56,0) S STATE=$S($D(^DIC(5,+STATE,0)):$P(^(0),U,1),1:"Unknown") "RTN","DVBCUTIL",57,0) W !!?0,"Address: ",?9,ADD1,! W:ADD2]"" ?9,ADD2,! W ?0,"City:",?9,CITY," ",STATE," ",ZIP,!?0,"County:",?9,CNTY,!! "RTN","DVBCUTIL",58,0) S PRDSV=$S($D(^DPT(DFN,.32)):$P(^(.32),U,3),1:"") I PRDSV]"" S PRDSV=$P(^DIC(21,PRDSV,0),U,1) "RTN","DVBCUTIL",59,0) W "Period of service: ",PRDSV,! "RTN","DVBCUTIL",60,0) S ELIG="",INCMP=0 "RTN","DVBCUTIL",61,0) W ?0,"Eligibility data:" I $D(^DPT(DFN,.36)),$P(^(.36),U,1)]"" S ELIG=$S($D(^DIC(8,+^(.36),0)):$P(^(0),U,6),1:"") "RTN","DVBCUTIL",62,0) I ELIG]"",$D(^DPT(DFN,.361)),^(.361)]"" S ELIG=ELIG_" ("_$S($P(^(.361),U,1)="P":"Pend ver",$P(^(.361),U,1)="R":"Pend re-verif",$P(^(.361),U,1)="V":"Verified",1:"Not verified")_")" "RTN","DVBCUTIL",63,0) I $D(^DPT(DFN,.29)),$P(^(.29),U,1)]"" S INCMP=1 "RTN","DVBCUTIL",64,0) I $D(^DPT(DA,.293)),$P(^(.293),U,1)=1 S INCMP=1 "RTN","DVBCUTIL",65,0) W ?19,ELIG_$S(ELIG]"":", ",1:"")_$S(INCMP=1:"Incompetent",1:""),! "RTN","DVBCUTIL",66,0) Q "RTN","DVBCUTIL",67,0) ; "RTN","DVBCUTIL",68,0) SSNSHRT ; ** Set SSN in the Format '***********' ** "RTN","DVBCUTIL",69,0) K DVBCSSNO "RTN","DVBCUTIL",70,0) S DVBCSSNO=$E(SSN,1,3)_" "_$E(SSN,4,5)_" "_$E(SSN,6,9) "RTN","DVBCUTIL",71,0) Q "RTN","DVBCUTIL",72,0) ; "RTN","DVBCUTIL",73,0) SSNOUT ; ** Set SSN in the Format '*********** (Z6789) ** "RTN","DVBCUTIL",74,0) D SSNSHRT "RTN","DVBCUTIL",75,0) S DVBCSSNO=DVBCSSNO_" ("_$E(PNAM)_$E(SSN,6,9)_")" "RTN","DVBCUTIL",76,0) Q "RTN","DVBCUTIL",77,0) ; "RTN","DVBCUTIL",78,0) ISFORGN(DVBIEN) ; ** Is country entry foreign? ** "RTN","DVBCUTIL",79,0) ; Input: DVBIEN - IEN of COUNTRY CODE file "RTN","DVBCUTIL",80,0) ; "RTN","DVBCUTIL",81,0) ; Output: Return 1 when country is foreign "RTN","DVBCUTIL",82,0) ; Return 0 when country is not foreign "RTN","DVBCUTIL",83,0) ; Return -1 on error "RTN","DVBCUTIL",84,0) ; "RTN","DVBCUTIL",85,0) N DVBCNTRY "RTN","DVBCUTIL",86,0) N DVBERR "RTN","DVBCUTIL",87,0) Q:$G(DVBIEN)="" -1 "RTN","DVBCUTIL",88,0) S DVBCNTRY=$$GET1^DIQ(779.004,DVBIEN_",",".01","","","DVBERR") "RTN","DVBCUTIL",89,0) Q $S($D(DVBERR):-1,DVBCNTRY="USA":0,1:1) "RTN","DVBCUTIL",90,0) ; "RTN","DVBCUTIL",91,0) GETCNTRY(DVBIEN) ; ** Get POSTAL NAME for country code ** "RTN","DVBCUTIL",92,0) ; Input: DVBIEN - IEN of COUNTRY CODE file "RTN","DVBCUTIL",93,0) ; "RTN","DVBCUTIL",94,0) ; Output: Return POSTAL NAME field on success or "RTN","DVBCUTIL",95,0) ; DESCRIPTION field when POSTAL NAME = ""; "RTN","DVBCUTIL",96,0) ; Otherwise, return "" on failure. "RTN","DVBCUTIL",97,0) ; "RTN","DVBCUTIL",98,0) N DVBCNTRY "RTN","DVBCUTIL",99,0) N DVBERR "RTN","DVBCUTIL",100,0) N DVBIENS "RTN","DVBCUTIL",101,0) N DVBNAME "RTN","DVBCUTIL",102,0) S DVBNAME="" "RTN","DVBCUTIL",103,0) I $G(DVBIEN)'="" D "RTN","DVBCUTIL",104,0) . S DVBIENS=DVBIEN_"," "RTN","DVBCUTIL",105,0) . D GETS^DIQ(779.004,DVBIENS,"1.3;2","E","DVBCNTRY","DVBERR") "RTN","DVBCUTIL",106,0) . I '$D(DVBERR) D "RTN","DVBCUTIL",107,0) . . S DVBNAME=$G(DVBCNTRY(779.004,DVBIENS,1.3,"E")) "RTN","DVBCUTIL",108,0) . . I DVBNAME="" S DVBNAME=$$UP^XLFSTR($G(DVBCNTRY(779.004,DVBIENS,2,"E"))) "RTN","DVBCUTIL",109,0) Q DVBNAME "VER") 8.0^22.0 "^DD",8994.5,8994.5,0) FIELD^^1^4 "^DD",8994.5,8994.5,0,"DDA") N "^DD",8994.5,8994.5,0,"DT") 3090409 "^DD",8994.5,8994.5,0,"IX","ACODE",8994.5,.03) "^DD",8994.5,8994.5,0,"IX","B",8994.5,.01) "^DD",8994.5,8994.5,0,"NM","REMOTE APPLICATION") "^DD",8994.5,8994.5,0,"VRPK") XU "^DD",8994.5,8994.5,.01,0) NAME^RF^^0;1^K:$L(X)>30!(X?.N)!($L(X)<3)!'(X'?1P.E) X "^DD",8994.5,8994.5,.01,1,0) ^.1 "^DD",8994.5,8994.5,.01,1,1,0) 8994.5^B "^DD",8994.5,8994.5,.01,1,1,1) S ^XWB(8994.5,"B",$E(X,1,30),DA)="" "^DD",8994.5,8994.5,.01,1,1,2) K ^XWB(8994.5,"B",$E(X,1,30),DA) "^DD",8994.5,8994.5,.01,3) NAME MUST BE 3-30 CHARACTERS, NOT NUMERIC OR STARTING WITH PUNCTUATION "^DD",8994.5,8994.5,.01,21,0) ^.001^2^2^3060328^^ "^DD",8994.5,8994.5,.01,21,1,0) This is the NAME of the REMOTE GUI APPLICATION for which the data in this "^DD",8994.5,8994.5,.01,21,2,0) entry pertains. "^DD",8994.5,8994.5,.02,0) CONTEXTOPTION^RP19'^DIC(19,^0;2^Q "^DD",8994.5,8994.5,.02,3) This is the option which should be given to the signed in visitor as the Context Option for this application. "^DD",8994.5,8994.5,.02,21,0) ^^7^7^3060403^ "^DD",8994.5,8994.5,.02,21,1,0) The name of the context (Client/Server or B-type) option that the "^DD",8994.5,8994.5,.02,21,2,0) application users will need that will be added as a secondary menu item. "^DD",8994.5,8994.5,.02,21,3,0) "^DD",8994.5,8994.5,.02,21,4,0) The user is signed on as a visitor and given the Context Option specified "^DD",8994.5,8994.5,.02,21,5,0) in this field as a secondary menu option. The application still needs to "^DD",8994.5,8994.5,.02,21,6,0) set the Context Option using the CreateContext method, but the visitor has "^DD",8994.5,8994.5,.02,21,7,0) it as a valid option so that it can be used. "^DD",8994.5,8994.5,.02,"DT") 3060403 "^DD",8994.5,8994.5,.03,0) APPLICATIONCODE^RF^^0;3^K:$L(X)>60!($L(X)<3) X "^DD",8994.5,8994.5,.03,1,0) ^.1 "^DD",8994.5,8994.5,.03,1,1,0) 8994.5^ACODE "^DD",8994.5,8994.5,.03,1,1,1) S ^XWB(8994.5,"ACODE",$E(X,1,30),DA)="" "^DD",8994.5,8994.5,.03,1,1,2) K ^XWB(8994.5,"ACODE",$E(X,1,30),DA) "^DD",8994.5,8994.5,.03,1,1,3) THIS CROSS-REFERENCE IS USED AS ENTRY BY THE APPLICATION CODE FOR THE APPLICATION. "^DD",8994.5,8994.5,.03,1,1,"DT") 3060210 "^DD",8994.5,8994.5,.03,3) This value is the HASHED value of the application's code phrase. "^DD",8994.5,8994.5,.03,21,0) ^^51^51^3060403^ "^DD",8994.5,8994.5,.03,21,1,0) This is the hashed value for a security phrase for the application and is "^DD",8994.5,8994.5,.03,21,2,0) described below. "^DD",8994.5,8994.5,.03,21,3,0) "^DD",8994.5,8994.5,.03,21,4,0) Security Phrase "^DD",8994.5,8994.5,.03,21,5,0) "^DD",8994.5,8994.5,.03,21,6,0) The security phrase is an application's entry into the REMOTE APPLICATION "^DD",8994.5,8994.5,.03,21,7,0) file (#8994.5) for accessing the information necessary to permit the "^DD",8994.5,8994.5,.03,21,8,0) application to enroll a remote user. Create a security phrase, case "^DD",8994.5,8994.5,.03,21,9,0) sensitive, and at programmer mode use the command (assuming the security "^DD",8994.5,8994.5,.03,21,10,0) phrase is "My Special Phrase") "^DD",8994.5,8994.5,.03,21,11,0) "^DD",8994.5,8994.5,.03,21,12,0) W $$EN^XUSHSH("My Special Phrase") "^DD",8994.5,8994.5,.03,21,13,0) "^DD",8994.5,8994.5,.03,21,14,0) The resulting value: "^DD",8994.5,8994.5,.03,21,15,0) "I&f).c`u:7@01#tL((x" "^DD",8994.5,8994.5,.03,21,16,0) "^DD",8994.5,8994.5,.03,21,17,0) This is the one-way hash value for the security phrase. It is this "^DD",8994.5,8994.5,.03,21,18,0) hashed value that will be entered into the ApplicationCode field (#.03) "^DD",8994.5,8994.5,.03,21,19,0) in the REMOTE APPLICATION file (#8994.5) for the application. "^DD",8994.5,8994.5,.03,21,20,0) "^DD",8994.5,8994.5,.03,21,21,0) To make a remote connection, the application will have the user sign onto "^DD",8994.5,8994.5,.03,21,22,0) the application's authenticating server (the one entered as "^DD",8994.5,8994.5,.03,21,23,0) CallbackServer) and then obtain a Token for the user (similar to "^DD",8994.5,8994.5,.03,21,24,0) "XWBHDL977-124367_0") using the "XUS SET VISITOR" RPC. The application "^DD",8994.5,8994.5,.03,21,25,0) will then disconnect from the authenticating server and set the new "^DD",8994.5,8994.5,.03,21,26,0) SecurityPhrase property for the TRPCBroker component to the unhashed "^DD",8994.5,8994.5,.03,21,27,0) security phrase concatenated with a caret ("^") and the token for the user "^DD",8994.5,8994.5,.03,21,28,0) (e.g., "My Special Phrase^XWBHDL977-124367_0") "^DD",8994.5,8994.5,.03,21,29,0) "^DD",8994.5,8994.5,.03,21,30,0) This property will be encoded and passed to the remote server for "^DD",8994.5,8994.5,.03,21,31,0) authentication; it will hash the security phrase and use the resulting "^DD",8994.5,8994.5,.03,21,32,0) value to identify the application's entry in the REMOTE APPLICATION file "^DD",8994.5,8994.5,.03,21,33,0) (#8994.5). The mechanism(s) for contacting the authenticating server "^DD",8994.5,8994.5,.03,21,34,0) will be identified and the authentication server will be requested to "^DD",8994.5,8994.5,.03,21,35,0) provide the demographic information necessary to identify the user and "^DD",8994.5,8994.5,.03,21,36,0) create or match an entry in the NEW PERSON file (#200) based on the token "^DD",8994.5,8994.5,.03,21,37,0) provided. With this information the user will be set up as a visitor "^DD",8994.5,8994.5,.03,21,38,0) entry and provided the context option specified. The application will "^DD",8994.5,8994.5,.03,21,39,0) then be notified that the user is connected. If there is no entry for "^DD",8994.5,8994.5,.03,21,40,0) the application, no match for the token, or the authenticating server can "^DD",8994.5,8994.5,.03,21,41,0) not be connected, the user will be prompted with a regular sign on screen "^DD",8994.5,8994.5,.03,21,42,0) (i.e., required to enter their Access and Verify codes). "^DD",8994.5,8994.5,.03,21,43,0) "^DD",8994.5,8994.5,.03,21,44,0) Since the security phrase is the application's identifier, we recommend "^DD",8994.5,8994.5,.03,21,45,0) that the security phrase in RPCBroker Delphi-based programs be identified "^DD",8994.5,8994.5,.03,21,46,0) as a const value in an include file. And that a substitute include file "^DD",8994.5,8994.5,.03,21,47,0) containing a phrase similar to that used above be included with release "^DD",8994.5,8994.5,.03,21,48,0) of the source code. It must be realized that the security phrase "^DD",8994.5,8994.5,.03,21,49,0) identifies any application that uses it as your application, and it "^DD",8994.5,8994.5,.03,21,50,0) would, of course, be desirable that rogue applications not appear to be "^DD",8994.5,8994.5,.03,21,51,0) your application. "^DD",8994.5,8994.5,.03,"DT") 3060210 "^DD",8994.5,8994.5,1,0) CALLBACKTYPE^8994.51S^^1;0 "^DD",8994.5,8994.5,1,21,0) ^^10^10^3060403^ "^DD",8994.5,8994.5,1,21,1,0) This is a multiple field. It may contain multiple values describing "^DD",8994.5,8994.5,1,21,2,0) mechanisms by which the remote site can contact the application's "^DD",8994.5,8994.5,1,21,3,0) authenticating site to obtain the demographic information. "^DD",8994.5,8994.5,1,21,4,0) "^DD",8994.5,8994.5,1,21,5,0) It consists of the following subfields: "^DD",8994.5,8994.5,1,21,6,0) "^DD",8994.5,8994.5,1,21,7,0) .01 CALLBACKTYPE "^DD",8994.5,8994.5,1,21,8,0) .02 CALLBACKPORT "^DD",8994.5,8994.5,1,21,9,0) .03 CALLBACKSERVER "^DD",8994.5,8994.5,1,21,10,0) .04 URLSTRING "^DD",8994.5,8994.5,1,"DT") 3060403 "^DD",8994.5,8994.51,0) CALLBACKTYPE SUB-FIELD^^.04^4 "^DD",8994.5,8994.51,0,"DT") 3090409 "^DD",8994.5,8994.51,0,"IX","B",8994.51,.01) "^DD",8994.5,8994.51,0,"NM","CALLBACKTYPE") "^DD",8994.5,8994.51,0,"UP") 8994.5 "^DD",8994.5,8994.51,.01,0) CALLBACKTYPE^MRS^R:RPC-BROKER;M:M2M-BROKER;H:HTTP;S:STATION-NUMBER;^0;1^Q "^DD",8994.5,8994.51,.01,1,0) ^.1 "^DD",8994.5,8994.51,.01,1,1,0) 8994.51^B "^DD",8994.5,8994.51,.01,1,1,1) S ^XWB(8994.5,DA(1),1,"B",$E(X,1,30),DA)="" "^DD",8994.5,8994.51,.01,1,1,2) K ^XWB(8994.5,DA(1),1,"B",$E(X,1,30),DA) "^DD",8994.5,8994.51,.01,3) Select one of the indicators for a Call back type for this Remote GUI Application "^DD",8994.5,8994.51,.01,21,0) ^.001^3^3^3090409^^^^ "^DD",8994.5,8994.51,.01,21,1,0) This field indicates the mechanism(s) by which the server should contact "^DD",8994.5,8994.51,.01,21,2,0) the authenticating server to obtain information necessary to sign the "^DD",8994.5,8994.51,.01,21,3,0) current user on to the current server. "^DD",8994.5,8994.51,.01,"DT") 3090409 "^DD",8994.5,8994.51,.02,0) CALLBACKPORT^RF^^0;2^K:$L(X)>5!($L(X)<2) X "^DD",8994.5,8994.51,.02,3) Answer must be 2-5 characters in length. "^DD",8994.5,8994.51,.02,21,0) ^.001^2^2^3060403^^ "^DD",8994.5,8994.51,.02,21,1,0) This is the port to be used for the callback to the authenticating server "^DD",8994.5,8994.51,.02,21,2,0) for the CALLBACKTYPE specified. "^DD",8994.5,8994.51,.02,"DT") 3060407 "^DD",8994.5,8994.51,.03,0) CALLBACKSERVER^RF^^0;3^K:$L(X)>60!($L(X)<3) X "^DD",8994.5,8994.51,.03,3) This should be the server name to be used to contact the authenticating server for accessing the data to authenticate the user for this Remote GUI Application. "^DD",8994.5,8994.51,.03,21,0) ^.001^2^2^3060403^^ "^DD",8994.5,8994.51,.03,21,1,0) This is the server designation to be used for the callback to the "^DD",8994.5,8994.51,.03,21,2,0) authenticating server for the CALLBACKTYPE specified. "^DD",8994.5,8994.51,.03,"DT") 3060123 "^DD",8994.5,8994.51,.04,0) URLSTRING^F^^0;4^K:$L(X)>60!($L(X)<1) X "^DD",8994.5,8994.51,.04,3) Answer must be 1-60 characters in length. "^DD",8994.5,8994.51,.04,21,0) ^^14^14^3060403^ "^DD",8994.5,8994.51,.04,21,1,0) This field holds the text that should follow the server address (field "^DD",8994.5,8994.51,.04,21,2,0) #.03) for HTTP connections to obtain the information for the user token "^DD",8994.5,8994.51,.04,21,3,0) passed in for a REMOTE APPLICATION connection. "^DD",8994.5,8994.51,.04,21,4,0) "^DD",8994.5,8994.51,.04,21,5,0) If the complete URL to be used for the callback is "^DD",8994.5,8994.51,.04,21,6,0) http://myserver.med.va.gov/some/kind/of/location/somePage.aspx "^DD",8994.5,8994.51,.04,21,7,0) "^DD",8994.5,8994.51,.04,21,8,0) The CALLBACKSERVER (#.03) field could be "^DD",8994.5,8994.51,.04,21,9,0) myserver.med.va.gov "^DD",8994.5,8994.51,.04,21,10,0) "^DD",8994.5,8994.51,.04,21,11,0) and the URLSTRING would be "^DD",8994.5,8994.51,.04,21,12,0) some/kind/of/location/somePage.aspx "^DD",8994.5,8994.51,.04,21,13,0) "^DD",8994.5,8994.51,.04,21,14,0) This field is only used if the CALLBACKTYPE (#.01) value is H for HTTP "^DD",8994.5,8994.51,.04,"DT") 3060407 "^DIC",8994.5,8994.5,0) REMOTE APPLICATION^8994.5 "^DIC",8994.5,8994.5,0,"GL") ^XWB(8994.5, "^DIC",8994.5,8994.5,"%D",0) ^^20^20^3060328^ "^DIC",8994.5,8994.5,"%D",1,0) The REMOTE APPLICATION file was introduced as part of the Broker Security "^DIC",8994.5,8994.5,"%D",2,0) Enhancement to secure access via the remote user or visitor approach by "^DIC",8994.5,8994.5,"%D",3,0) GUI applications (formerly known as the CAPRI approach for the first "^DIC",8994.5,8994.5,"%D",4,0) application to use this access style). The remote visitor access permits "^DIC",8994.5,8994.5,"%D",5,0) applications where users need to access a large number of sites to do so "^DIC",8994.5,8994.5,"%D",6,0) without requiring a separate access code and verify code at each site. "^DIC",8994.5,8994.5,"%D",7,0) "^DIC",8994.5,8994.5,"%D",8,0) Following the Broker Security Enhancement, applications will be able to "^DIC",8994.5,8994.5,"%D",9,0) use the remote visitor access only if they have an entry in this file with "^DIC",8994.5,8994.5,"%D",10,0) a one-way hash of a secure phrase. Identification of an entry in the file "^DIC",8994.5,8994.5,"%D",11,0) is based on the application passing in the original phrase which is then "^DIC",8994.5,8994.5,"%D",12,0) hashed and used for a cross-reference lookup. The application must have at "^DIC",8994.5,8994.5,"%D",13,0) least one entry in the CALLBACKTYPE sub-file indicating a connection type, "^DIC",8994.5,8994.5,"%D",14,0) a valid address for the authenticating server, and a connection port "^DIC",8994.5,8994.5,"%D",15,0) number. This information is necessary for the remote server to directly "^DIC",8994.5,8994.5,"%D",16,0) connect the authenticating server to obtain the demographic information "^DIC",8994.5,8994.5,"%D",17,0) necessary to create or match the visitor entry in the NEW PERSON file "^DIC",8994.5,8994.5,"%D",18,0) (#200). The application will also specify the desired context option for "^DIC",8994.5,8994.5,"%D",19,0) the user and this will be given to the remote visitor instead of the "^DIC",8994.5,8994.5,"%D",20,0) application having to figure out how to set this value. "^DIC",8994.5,"B","REMOTE APPLICATION",8994.5) "BLD",7413,6) ^134 **END** **END**