Released DVBA*2.7*181 SEQ #160 Extracted from mail message **KIDS**:DVBA*2.7*181^ **INSTALL NAME** DVBA*2.7*181 "BLD",8365,0) DVBA*2.7*181^AUTOMATED MED INFO EXCHANGE^0^3130228^y "BLD",8365,1,0) ^^1^1^3130108^ "BLD",8365,1,1,0) Please see FORUM for a more complete description of DVBA*2.7*181. "BLD",8365,4,0) ^9.64PA^396.918^2 "BLD",8365,4,396.9,0) 396.9 "BLD",8365,4,396.9,222) y^y^f^^^^n "BLD",8365,4,396.918,0) 396.918 "BLD",8365,4,396.918,222) y^y^f^^n^^y^a^n "BLD",8365,4,"B",396.9,396.9) "BLD",8365,4,"B",396.918,396.918) "BLD",8365,6.3) 38 "BLD",8365,"ABPKG") n "BLD",8365,"INIT") POST^DVBA181P "BLD",8365,"KRN",0) ^9.67PA^779.2^20 "BLD",8365,"KRN",.4,0) .4 "BLD",8365,"KRN",.4,"NM",0) ^9.68A^^ "BLD",8365,"KRN",.401,0) .401 "BLD",8365,"KRN",.402,0) .402 "BLD",8365,"KRN",.403,0) .403 "BLD",8365,"KRN",.5,0) .5 "BLD",8365,"KRN",.5,"NM",0) ^9.68A^^ "BLD",8365,"KRN",.84,0) .84 "BLD",8365,"KRN",.84,"NM",0) ^9.68A^^ "BLD",8365,"KRN",3.6,0) 3.6 "BLD",8365,"KRN",3.8,0) 3.8 "BLD",8365,"KRN",3.8,"NM",0) ^9.68A^1^1 "BLD",8365,"KRN",3.8,"NM",1,0) DVBA VR VOCREHAB PERSONNEL^^0 "BLD",8365,"KRN",3.8,"NM","B","DVBA VR VOCREHAB PERSONNEL",1) "BLD",8365,"KRN",9.2,0) 9.2 "BLD",8365,"KRN",9.8,0) 9.8 "BLD",8365,"KRN",9.8,"NM",0) ^9.68A^10^10 "BLD",8365,"KRN",9.8,"NM",1,0) DVBABURL^^0^B6313636 "BLD",8365,"KRN",9.8,"NM",2,0) DVBAB82^^0^B116645006 "BLD",8365,"KRN",9.8,"NM",3,0) DVBANTFY^^0^B2472090 "BLD",8365,"KRN",9.8,"NM",4,0) DVBAVRX1^^0^B93077870 "BLD",8365,"KRN",9.8,"NM",5,0) DVBAVRX2^^0^B30177401 "BLD",8365,"KRN",9.8,"NM",6,0) DVBA8861^^0^B137760050 "BLD",8365,"KRN",9.8,"NM",7,0) DVBAMVI1^^0^B86814663 "BLD",8365,"KRN",9.8,"NM",8,0) DVBAMVI2^^0^B42005360 "BLD",8365,"KRN",9.8,"NM",9,0) DVBAHWSC^^0^B4863059 "BLD",8365,"KRN",9.8,"NM",10,0) DVBABFRM^^0^B55183576 "BLD",8365,"KRN",9.8,"NM","B","DVBA8861",6) "BLD",8365,"KRN",9.8,"NM","B","DVBAB82",2) "BLD",8365,"KRN",9.8,"NM","B","DVBABFRM",10) "BLD",8365,"KRN",9.8,"NM","B","DVBABURL",1) "BLD",8365,"KRN",9.8,"NM","B","DVBAHWSC",9) "BLD",8365,"KRN",9.8,"NM","B","DVBAMVI1",7) "BLD",8365,"KRN",9.8,"NM","B","DVBAMVI2",8) "BLD",8365,"KRN",9.8,"NM","B","DVBANTFY",3) "BLD",8365,"KRN",9.8,"NM","B","DVBAVRX1",4) "BLD",8365,"KRN",9.8,"NM","B","DVBAVRX2",5) "BLD",8365,"KRN",19,0) 19 "BLD",8365,"KRN",19,"NM",0) ^9.68A^2^2 "BLD",8365,"KRN",19,"NM",1,0) DVBA CAPRI GUI^^0 "BLD",8365,"KRN",19,"NM",2,0) DVBA VR BACKGROUND^^0 "BLD",8365,"KRN",19,"NM","B","DVBA CAPRI GUI",1) "BLD",8365,"KRN",19,"NM","B","DVBA VR BACKGROUND",2) "BLD",8365,"KRN",19.1,0) 19.1 "BLD",8365,"KRN",19.1,"NM",0) ^9.68A^2^2 "BLD",8365,"KRN",19.1,"NM",1,0) DVBA CAPRI VRE_COUNSELOR^^0 "BLD",8365,"KRN",19.1,"NM",2,0) DVBA CAPRI VHA_COORDINATOR^^0 "BLD",8365,"KRN",19.1,"NM","B","DVBA CAPRI VHA_COORDINATOR",2) "BLD",8365,"KRN",19.1,"NM","B","DVBA CAPRI VRE_COUNSELOR",1) "BLD",8365,"KRN",101,0) 101 "BLD",8365,"KRN",101,"NM",0) ^9.68A^^ "BLD",8365,"KRN",409.61,0) 409.61 "BLD",8365,"KRN",409.61,"NM",0) ^9.68A^^ "BLD",8365,"KRN",771,0) 771 "BLD",8365,"KRN",771,"NM",0) ^9.68A^^ "BLD",8365,"KRN",779.2,0) 779.2 "BLD",8365,"KRN",779.2,"NM",0) ^9.68A^^ "BLD",8365,"KRN",870,0) 870 "BLD",8365,"KRN",8989.51,0) 8989.51 "BLD",8365,"KRN",8989.51,"NM",0) ^9.68A^7^7 "BLD",8365,"KRN",8989.51,"NM",1,0) DVBAB CAPRI VIRTUALVA PROD URL^^0 "BLD",8365,"KRN",8989.51,"NM",2,0) DVBAB CAPRI VIRTUALVA TEST URL^^0 "BLD",8365,"KRN",8989.51,"NM",3,0) DVBAB CAPRI VVA PROD PASSWD^^0 "BLD",8365,"KRN",8989.51,"NM",4,0) DVBAB CAPRI VVA TEST PASSWD^^0 "BLD",8365,"KRN",8989.51,"NM",5,0) DVBAB CAPRI VVA PROD TOKEN^^0 "BLD",8365,"KRN",8989.51,"NM",6,0) DVBAB CAPRI VVA TEST TOKEN^^0 "BLD",8365,"KRN",8989.51,"NM",7,0) DVBAB CAPRI VVA USER^^0 "BLD",8365,"KRN",8989.51,"NM","B","DVBAB CAPRI VIRTUALVA PROD URL",1) "BLD",8365,"KRN",8989.51,"NM","B","DVBAB CAPRI VIRTUALVA TEST URL",2) "BLD",8365,"KRN",8989.51,"NM","B","DVBAB CAPRI VVA PROD PASSWD",3) "BLD",8365,"KRN",8989.51,"NM","B","DVBAB CAPRI VVA PROD TOKEN",5) "BLD",8365,"KRN",8989.51,"NM","B","DVBAB CAPRI VVA TEST PASSWD",4) "BLD",8365,"KRN",8989.51,"NM","B","DVBAB CAPRI VVA TEST TOKEN",6) "BLD",8365,"KRN",8989.51,"NM","B","DVBAB CAPRI VVA USER",7) "BLD",8365,"KRN",8989.52,0) 8989.52 "BLD",8365,"KRN",8989.52,"NM",0) ^9.68A^^ "BLD",8365,"KRN",8994,0) 8994 "BLD",8365,"KRN",8994,"NM",0) ^9.68A^4^4 "BLD",8365,"KRN",8994,"NM",1,0) DVBAB GET VVA TOKEN^^0 "BLD",8365,"KRN",8994,"NM",2,0) DVBAB 8861 NOTIFICATIONS^^0 "BLD",8365,"KRN",8994,"NM",3,0) DVBA MVI GET CORRESPONDING IDS^^0 "BLD",8365,"KRN",8994,"NM",4,0) DVBA MVI SEARCH PERSON^^0 "BLD",8365,"KRN",8994,"NM","B","DVBA MVI GET CORRESPONDING IDS",3) "BLD",8365,"KRN",8994,"NM","B","DVBA MVI SEARCH PERSON",4) "BLD",8365,"KRN",8994,"NM","B","DVBAB 8861 NOTIFICATIONS",2) "BLD",8365,"KRN",8994,"NM","B","DVBAB GET VVA TOKEN",1) "BLD",8365,"KRN","B",.4,.4) "BLD",8365,"KRN","B",.401,.401) "BLD",8365,"KRN","B",.402,.402) "BLD",8365,"KRN","B",.403,.403) "BLD",8365,"KRN","B",.5,.5) "BLD",8365,"KRN","B",.84,.84) "BLD",8365,"KRN","B",3.6,3.6) "BLD",8365,"KRN","B",3.8,3.8) "BLD",8365,"KRN","B",9.2,9.2) "BLD",8365,"KRN","B",9.8,9.8) "BLD",8365,"KRN","B",19,19) "BLD",8365,"KRN","B",19.1,19.1) "BLD",8365,"KRN","B",101,101) "BLD",8365,"KRN","B",409.61,409.61) "BLD",8365,"KRN","B",771,771) "BLD",8365,"KRN","B",779.2,779.2) "BLD",8365,"KRN","B",870,870) "BLD",8365,"KRN","B",8989.51,8989.51) "BLD",8365,"KRN","B",8989.52,8989.52) "BLD",8365,"KRN","B",8994,8994) "BLD",8365,"QDEF") ^^^^NO^^^^NO^^NO "BLD",8365,"QUES",0) ^9.62^^ "BLD",8365,"REQB",0) ^9.611^^ "DATA",396.918,1,0) EYE "DATA",396.918,2,0) DENTAL "DATA",396.918,3,0) OCCUPATIONAL - GENERAL PHYSICAL FORM FOR EMPLOYMENT "DATA",396.918,4,0) TRAINING - GENERAL PHYSICAL FORM FOR SCHOOL ADMISSION "DATA",396.918,5,0) TBI/POLY TRAUMA REHABILITATION "DATA",396.918,6,0) SCI REHABILITATION "DATA",396.918,7,0) BLIND REHABILITATION "DATA",396.918,8,0) PRIMARY CARE "DATA",396.918,9,0) MENTAL HEALTH (PSYCHIATRY, SUBSTANCE ABUSE, PTSD) "DATA",396.918,10,0) MENTAL HEALTH (*) "DATA",396.918,11,0) PHYSICAL THERAPY "DATA",396.918,12,0) SPEECH THERAPY "DATA",396.918,13,0) OCCUPATIONAL THERAPY "DATA",396.918,14,0) PAIN MANAGEMENT "DATA",396.918,15,0) VISUALLY IMPAIRED SERVICE "DATA",396.918,16,0) BURN CARE MANAGEMENT "DATA",396.918,17,0) TBI EVALUATION "DATA",396.918,18,0) DME/PROSTHETICS "DATA",396.918,19,0) EAR/NOSE/THROAT "DATA",396.918,20,0) AUDIOLOGY "DATA",396.918,21,0) SUTURE REMOVAL "DATA",396.918,22,0) WOUND CARE "DATA",396.918,23,0) CARDIOLOGY "DATA",396.918,24,0) ORTHOPEDIC "DATA",396.918,25,0) NEUROLOGY "DATA",396.918,26,0) PRIMARY CARE PHYSICIAN - HISA GRANT/PRESCRIPTION FOR HISA MODIFICATIONS "DATA",396.918,27,0) PRIMARY CARE PHYSICIAN - GENERAL CARE/COORDINATION OF SERVICES "DATA",396.918,28,0) OTHER "FIA",396.9) FORM 28-8861 "FIA",396.9,0) ^DVB(396.9, "FIA",396.9,0,0) 396.9D "FIA",396.9,0,1) y^y^f^^^^n "FIA",396.9,0,10) "FIA",396.9,0,11) "FIA",396.9,0,"RLRO") "FIA",396.9,0,"VR") 2.7^DVBA "FIA",396.9,396.9) 0 "FIA",396.9,396.912) 0 "FIA",396.9,396.914) 0 "FIA",396.918) MEDICAL SERVICES REQUESTED "FIA",396.918,0) ^DVB(396.918, "FIA",396.918,0,0) 396.918 "FIA",396.918,0,1) y^y^f^^n^^y^a^n "FIA",396.918,0,10) "FIA",396.918,0,11) "FIA",396.918,0,"RLRO") "FIA",396.918,0,"VR") 2.7^DVBA "FIA",396.918,396.918) 0 "INIT") POST^DVBA181P "IX",396.9,396.9,"ARSDT",0) 396.9^ARSDT^Performs sorting on request status & date.^R^^R^IR^I^396.9^^^^^S "IX",396.9,396.9,"ARSDT",.1,0) ^^2^2^3120606^^ "IX",396.9,396.9,"ARSDT",.1,1,0) This cross-reference will perform sorting on the Request Status "IX",396.9,396.9,"ARSDT",.1,2,0) and Request Date fields. "IX",396.9,396.9,"ARSDT",1) S ^DVB(396.9,"ARSDT",$E(X(1),1,10),$E(X(2),1,12),DA)="" "IX",396.9,396.9,"ARSDT",1.4) Q "IX",396.9,396.9,"ARSDT",2) K ^DVB(396.9,"ARSDT",$E(X(1),1,10),$E(X(2),1,12),DA) "IX",396.9,396.9,"ARSDT",2.4) Q "IX",396.9,396.9,"ARSDT",2.5) K ^DVB(396.9,"ARSDT") "IX",396.9,396.9,"ARSDT",11.1,0) ^.114IA^2^2 "IX",396.9,396.9,"ARSDT",11.1,1,0) 1^F^396.9^13^10^1^F "IX",396.9,396.9,"ARSDT",11.1,1,3) "IX",396.9,396.9,"ARSDT",11.1,2,0) 2^F^396.9^.01^12^2^F "KRN",3.8,437,-1) 0^1 "KRN",3.8,437,0) DVBA VR VOCREHAB PERSONNEL^PU^y^^^^ "KRN",3.8,437,3) "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^3120628^^^^ "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) 62770,52465 "KRN",19,9510,"RPC",0) ^19.05P^143^143 "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,"RPC",138,0) DVBAB GET SET "KRN",19,9510,"RPC",139,0) DVBAB GET VVA TOKEN "KRN",19,9510,"RPC",140,0) VAFCTFU CONVERT ICN TO DFN "KRN",19,9510,"RPC",141,0) DVBAB 8861 NOTIFICATIONS "KRN",19,9510,"RPC",142,0) DVBA MVI GET CORRESPONDING IDS "KRN",19,9510,"RPC",143,0) DVBA MVI SEARCH PERSON "KRN",19,9510,"U") CAPRI GUI (BROKER) "KRN",19,12927,-1) 0^2 "KRN",19,12927,0) DVBA VR BACKGROUND^DVBA VR BACKGROUND^^R^^^^^^^^AUTOMATED MED INFO EXCHANGE "KRN",19,12927,1,0) ^19.06^4^4^3120814^^^^ "KRN",19,12927,1,1,0) DVBA VR BACKGROUND "KRN",19,12927,1,2,0) RUNS IN THE BACKGROUND FOR THE DVBA 8861 VOCREHAB "KRN",19,12927,1,3,0) SENDS NOTIFICATIONS BASED ON STATUS AND AGE OF STATUS "KRN",19,12927,1,4,0) UPDATES STATUS "KRN",19,12927,25) EN^DVBAVRX1 "KRN",19,12927,"U") DVBA VR BACKGROUND "KRN",19.1,589,-1) 0^1 "KRN",19.1,589,0) DVBA CAPRI VRE_COUNSELOR^VOCREHAB VRE COUNSELOR^l "KRN",19.1,589,1,0) ^19.11^4^4^3130228^^ "KRN",19.1,589,1,1,0) Anyone needing to see the VocRehab tab within CAPRI will need to "KRN",19.1,589,1,2,0) be assigned the CAPRI VRE Counselor security key. This key gives "KRN",19.1,589,1,3,0) the user access to all portions of VocRehab except the ability to "KRN",19.1,589,1,4,0) assign a medical consult to a request for medical services. "KRN",19.1,591,-1) 0^2 "KRN",19.1,591,0) DVBA CAPRI VHA_COORDINATOR^DVBA VOCREHAB "KRN",19.1,591,1,0) ^19.11^6^6^3130228^^ "KRN",19.1,591,1,1,0) The CAPRI VHA Coordinator key makes visible within CAPRI a button "KRN",19.1,591,1,2,0) allowing users with this key to assign a medical consult (created "KRN",19.1,591,1,3,0) in CPRS) to a request for medical services. The only function of "KRN",19.1,591,1,4,0) this security key is allowing the ability to assign consults. "KRN",19.1,591,1,5,0) Users with this security key will also need the CAPRI VRE "KRN",19.1,591,1,6,0) Counselor security key as well. "KRN",8989.5,2813,0) 223;DIC(9.4,^DVBAB CAPRI VIRTUALVA PROD URL^1 "KRN",8989.5,2813,1) https://vbaphi5dopp.vba.va.gov:7002/VABFI/services/vva "KRN",8989.5,2814,0) 223;DIC(9.4,^DVBAB CAPRI VIRTUALVA TEST URL^1 "KRN",8989.5,2814,1) https://vbaphi5topp.vba.va.gov:7002/VABFI/services/vva "KRN",8989.5,2844,0) 223;DIC(9.4,^DVBAB CAPRI VVA USER^1 "KRN",8989.5,2844,1) CAPRI "KRN",8989.5,2845,0) 223;DIC(9.4,^DVBAB CAPRI VVA TEST PASSWD^1 "KRN",8989.5,2845,1) XXXXX "KRN",8989.5,2846,0) 223;DIC(9.4,^DVBAB CAPRI VVA PROD PASSWD^1 "KRN",8989.5,2846,1) Passw0rd1 "KRN",8989.5,2847,0) 223;DIC(9.4,^DVBAB CAPRI VVA TEST TOKEN^1 "KRN",8989.5,2847,1) Username-1 "KRN",8989.5,2848,0) 223;DIC(9.4,^DVBAB CAPRI VVA PROD TOKEN^1 "KRN",8989.5,2848,1) Username-1 "KRN",8989.51,643,-1) 0^1 "KRN",8989.51,643,0) DVBAB CAPRI VIRTUALVA PROD URL^Virtual VA Production URL^0 "KRN",8989.51,643,1) F^^Enter the URL of the Virtual VA Production server. "KRN",8989.51,643,20,0) ^8989.512^2^2^3120514^ "KRN",8989.51,643,20,1,0) This is the URL that CAPRI utilizes to connect to the Virtual VA "KRN",8989.51,643,20,2,0) production server. "KRN",8989.51,643,30,0) ^8989.513I^1^1 "KRN",8989.51,643,30,1,0) 1^9.4 "KRN",8989.51,644,-1) 0^2 "KRN",8989.51,644,0) DVBAB CAPRI VIRTUALVA TEST URL^Virtual VA Test system URL^0 "KRN",8989.51,644,1) F^^Enter the URL of the Virtual VA Production Test server. "KRN",8989.51,644,20,0) ^8989.512^2^2^3120514^^ "KRN",8989.51,644,20,1,0) This is the URL that CAPRI utilizes to connect to the Virtual VA test "KRN",8989.51,644,20,2,0) server. "KRN",8989.51,644,30,0) ^8989.513I^1^1 "KRN",8989.51,644,30,1,0) 1^9.4 "KRN",8989.51,645,-1) 0^7 "KRN",8989.51,645,0) DVBAB CAPRI VVA USER^CAPRI VIRTUALVA USER^0 "KRN",8989.51,645,1) F^^Enter the fixed username for the Virtual VA web service. "KRN",8989.51,645,20,0) ^8989.512^1^1^3120531^^ "KRN",8989.51,645,20,1,0) This is the username that CAPRI passes to the Virtual VA web service. "KRN",8989.51,645,30,0) ^8989.513I^1^1 "KRN",8989.51,645,30,1,0) 1^9.4 "KRN",8989.51,646,-1) 0^4 "KRN",8989.51,646,0) DVBAB CAPRI VVA TEST PASSWD^CAPRI VIRTUALVA TEST PASSWORD^0 "KRN",8989.51,646,1) F^^Enter the password for the Test Virtual VA web service. "KRN",8989.51,646,20,0) ^^1^1^3120531^ "KRN",8989.51,646,20,1,0) This is the password that CAPRI passes to Test Virtual VA web service. "KRN",8989.51,646,30,0) ^8989.513I^1^1 "KRN",8989.51,646,30,1,0) 1^9.4 "KRN",8989.51,647,-1) 0^5 "KRN",8989.51,647,0) DVBAB CAPRI VVA PROD TOKEN^CAPRI VIRTUALVA PRODUCTION TOKEN^0 "KRN",8989.51,647,1) F^^Enter the token required to connect to the Virtual VA web service. "KRN",8989.51,647,20,0) ^8989.512^1^1^3120531^^ "KRN",8989.51,647,20,1,0) This is the token used to login to the production Virtual VA web service. "KRN",8989.51,647,30,0) ^8989.513I^1^1 "KRN",8989.51,647,30,1,0) 1^9.4 "KRN",8989.51,648,-1) 0^6 "KRN",8989.51,648,0) DVBAB CAPRI VVA TEST TOKEN^CAPRI VIRTUAL VA TEST TOKEN^0 "KRN",8989.51,648,1) F^^Enter the token passed to the TEST Virtual VA web service. "KRN",8989.51,648,20,0) ^8989.512^2^2^3120531^^ "KRN",8989.51,648,20,1,0) This is the token that is passed to login to the test Virtual VA web "KRN",8989.51,648,20,2,0) service. "KRN",8989.51,648,30,0) ^8989.513I^1^1 "KRN",8989.51,648,30,1,0) 1^9.4 "KRN",8989.51,649,-1) 0^3 "KRN",8989.51,649,0) DVBAB CAPRI VVA PROD PASSWD^CAPRI VIRTUALVA PRODUCTION PASSWORD^0 "KRN",8989.51,649,1) F^^Enter the password for the Production Virtual VA web service. "KRN",8989.51,649,20,0) ^^1^1^3120531^ "KRN",8989.51,649,20,1,0) This is the password passed to the Production Virtual VA web service. "KRN",8989.51,649,30,0) ^8989.513I^1^1 "KRN",8989.51,649,30,1,0) 1^9.4 "KRN",8994,1090,-1) 0^1 "KRN",8994,1090,0) DVBAB GET VVA TOKEN^VVATOKEN^DVBABURL^1^R "KRN",8994,1090,1,0) ^^2^2^3120531^ "KRN",8994,1090,1,1,0) This remote procedure retrieves the username, password, and token value "KRN",8994,1090,1,2,0) passed to the Virtual VA web service. "KRN",8994,1090,3,0) ^^3^3^3120531^ "KRN",8994,1090,3,1,0) Returns the values for username, password, and token as a single "KRN",8994,1090,3,2,0) caret-delimited string. "KRN",8994,1090,3,3,0) Example: capri^XXXXX^Username-1 "KRN",8994,1101,-1) 0^2 "KRN",8994,1101,0) DVBAB 8861 NOTIFICATIONS^ENTER^DVBANTFY^1^R^0^^0 "KRN",8994,1101,1,0) ^8994.01^1^1^3120815^^^^ "KRN",8994,1101,1,1,0) This will perform MailMan notifications for Form 8861 Requests based on the status of the request. "KRN",8994,1101,2,0) ^8994.02A^2^2 "KRN",8994,1101,2,1,0) IEN^1^5^1^1 "KRN",8994,1101,2,1,1,0) ^8994.021^1^1^3120628^^^ "KRN",8994,1101,2,1,1,1,0) IEN of the request. "KRN",8994,1101,2,2,0) STAT^1^9^1^2 "KRN",8994,1101,2,2,1,0) ^8994.021^1^1^3120815^^^^ "KRN",8994,1101,2,2,1,1,0) Status of Form 8861 request. This determines what message is sent and to whom. "KRN",8994,1101,2,"B","IEN",1) "KRN",8994,1101,2,"B","STAT",2) "KRN",8994,1101,2,"PARAMSEQ",1,1) "KRN",8994,1101,2,"PARAMSEQ",2,2) "KRN",8994,1101,3,0) ^8994.03^1^1^3120711^^^^ "KRN",8994,1101,3,1,0) The RPC returns either a success or failure to send the MailMan notification, either 0 or 1. "KRN",8994,1102,-1) 0^4 "KRN",8994,1102,0) DVBA MVI SEARCH PERSON^FNDPAT^DVBAMVI1^2^A^^^1 "KRN",8994,1102,1,0) ^8994.01^2^2^3121004^^^^ "KRN",8994,1102,1,1,0) This remote procedure passes the delimited person traits to the MVI "KRN",8994,1102,1,2,0) SEARCH PERSON web service and returns the results of the search. "KRN",8994,1102,2,0) ^8994.02A^4^3 "KRN",8994,1102,2,2,0) PERSON TRAITS^1^^1^1 "KRN",8994,1102,2,2,1,0) ^8994.021^10^10^3120813^^^ "KRN",8994,1102,2,2,1,1,0) Patient demographics used for search contained in a single "^"-delimited "KRN",8994,1102,2,2,1,2,0) string. "KRN",8994,1102,2,2,1,3,0) "KRN",8994,1102,2,2,1,4,0) Piece 1: FIRSTNAME (required) "KRN",8994,1102,2,2,1,5,0) Piece 2: MIDDLENAME or INITIAL (optional) "KRN",8994,1102,2,2,1,6,0) Piece 3: LASTNAME (required) "KRN",8994,1102,2,2,1,7,0) Piece 4: SSN (9 digits) (required) "KRN",8994,1102,2,2,1,8,0) Piece 5: BIRTHDATE (FM format) (required) "KRN",8994,1102,2,2,1,9,0) "KRN",8994,1102,2,2,1,10,0) Example: CAPRI^TEST^PATIENT^999999999^2540101 "KRN",8994,1102,2,3,0) INITIAL QUANTITY^1^^0^2 "KRN",8994,1102,2,3,1,0) ^8994.021^3^3^3121004^^^^ "KRN",8994,1102,2,3,1,1,0) This optional parameter populates the initialQuantity value attribute in "KRN",8994,1102,2,3,1,2,0) the 1305 HL7v3 message. The minimum value is 1 and the maximum value is "KRN",8994,1102,2,3,1,3,0) 10. The parameter will default to 10 when the parameter is not defined. "KRN",8994,1102,2,4,0) NAME FORMAT^1^^0^3 "KRN",8994,1102,2,4,1,0) ^8994.021^4^4^3121004^^ "KRN",8994,1102,2,4,1,1,0) This optional parameter controls the format of the full name result "KRN",8994,1102,2,4,1,2,0) returned. Setting the parameter to 1 causes the name to be formatted as "KRN",8994,1102,2,4,1,3,0) LASTNAME,FIRSTNAME MIDDLENAME SUFFIX. Any other value or no value causes "KRN",8994,1102,2,4,1,4,0) the name to be formatted as FIRSTNAME MIDDLENAME LASTNAME SUFFIX. "KRN",8994,1102,2,"B","INITIAL QUANTITY",3) "KRN",8994,1102,2,"B","NAME FORMAT",4) "KRN",8994,1102,2,"B","PERSON TRAITS",2) "KRN",8994,1102,2,"PARAMSEQ",1,2) "KRN",8994,1102,2,"PARAMSEQ",2,3) "KRN",8994,1102,2,"PARAMSEQ",3,4) "KRN",8994,1102,3,0) ^^31^31^3121004^ "KRN",8994,1102,3,1,0) The zero array node returns the caret-delimited record count and search "KRN",8994,1102,3,2,0) status results. "KRN",8994,1102,3,3,0) "KRN",8994,1102,3,4,0) Piece 1: Returned record count "KRN",8994,1102,3,5,0) Piece 2: OK or error message text "KRN",8994,1102,3,6,0) "KRN",8994,1102,3,7,0) Array node 1 starts the list of caret-delimited matching patient "KRN",8994,1102,3,8,0) records. "KRN",8994,1102,3,9,0) "KRN",8994,1102,3,10,0) Piece 1: FULLNAME "KRN",8994,1102,3,11,0) Piece 2: SSN (9 digits) "KRN",8994,1102,3,12,0) Piece 3: DATE OF BIRTH (external format) "KRN",8994,1102,3,13,0) Pieces 4-7 contain the MVI ID components "KRN",8994,1102,3,14,0) Piece 4: ID "KRN",8994,1102,3,15,0) Piece 5: IdType "KRN",8994,1102,3,16,0) Piece 6: Assigning Location "KRN",8994,1102,3,17,0) Piece 7: Assigning Issuer "KRN",8994,1102,3,18,0) "KRN",8994,1102,3,19,0) Example results: "KRN",8994,1102,3,20,0) "KRN",8994,1102,3,21,0) Default name format: "KRN",8994,1102,3,22,0) R(0)=2^OK "KRN",8994,1102,3,23,0) R(1)=CAPRI PATIENT^111905454^01/01/1980^1062212234V192931^NI^200M^USVHA "KRN",8994,1102,3,24,0) R(2)=CAPRI T PATIENT^111905454^01/01/1980^1008591712V479586^NI^200M^USVHA "KRN",8994,1102,3,25,0) "KRN",8994,1102,3,26,0) VistA name format: "KRN",8994,1102,3,27,0) R(0)=1^OK "KRN",8994,1102,3,28,0) R(1)=PATIENT,CAPRI T^111905454^01/01/1980^1008591712V479586^NI^200M^USVHA "KRN",8994,1102,3,29,0) "KRN",8994,1102,3,30,0) Error: "KRN",8994,1102,3,31,0) R(0)=0^Acknowledgement Error: Multiple Matches Found[4] "KRN",8994,1105,-1) 0^3 "KRN",8994,1105,0) DVBA MVI GET CORRESPONDING IDS^GETIDS^DVBAMVI2^2^A^^^1 "KRN",8994,1105,1,0) ^8994.01^3^3^3120813^^ "KRN",8994,1105,1,1,0) The remote procedure passes the Integration Control Number ID to the MVI "KRN",8994,1105,1,2,0) GET CORRESPONDING IDS web service and returns the list of VAMC treating "KRN",8994,1105,1,3,0) facilities for the selected identifier. "KRN",8994,1105,2,0) ^8994.02A^1^1 "KRN",8994,1105,2,1,0) SOURCE ID^1^250^1^1 "KRN",8994,1105,2,1,1,0) ^8994.021^3^3^3120813^^ "KRN",8994,1105,2,1,1,1,0) This is the Integration Control Number (ICN) used to identify the patient "KRN",8994,1105,2,1,1,2,0) that is selected from the MVI SEARCH PERSON web service results. "KRN",8994,1105,2,1,1,3,0) Format: "1008523099V750710^NI^200M^USVHA^" "KRN",8994,1105,2,"B","SOURCE ID",1) "KRN",8994,1105,2,"PARAMSEQ",1,1) "KRN",8994,1105,3,0) ^8994.03^10^10^3120813^^ "KRN",8994,1105,3,1,0) List of VAMC treating facilities associated with the passed identifier. "KRN",8994,1105,3,2,0) Each line contains INSTITUTION (#4) file IEN, station name ,and station "KRN",8994,1105,3,3,0) number delimited by a caret ("^"). The first entry in the list contains "KRN",8994,1105,3,4,0) the total number of stations returned. "KRN",8994,1105,3,5,0) "KRN",8994,1105,3,6,0) Format: instutionIEN^stationName^stationNumber "KRN",8994,1105,3,7,0) "KRN",8994,1105,3,8,0) Example: DVBOUT(0)=2 "KRN",8994,1105,3,9,0) DVBOUT(1)="516^BAY PINES VA HCS^516" "KRN",8994,1105,3,10,0) DVBOUT(2)="523^BOSTON HCS VAMC^523" "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",11,3.8) 3.8;11;;;MAILG^XPDTA1;MAILGF1^XPDIA1;MAILGE1^XPDIA1;MAILGF2^XPDIA1;;MAILGDEL^XPDIA1(%) "ORD",11,3.8,0) MAIL GROUP "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 "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) 181^3130228 "PKG",223,22,1,"PAH",1,1,0) ^^1^1^3130228 "PKG",223,22,1,"PAH",1,1,1,0) Please see FORUM for a more complete description of DVBA*2.7*181. "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") 11 "RTN","DVBA181P") 0^^B123889382^n/a "RTN","DVBA181P",1,0) DVBA181P ;ALB/RPM - PATCH DVBA*2.7*181 POST-INSTALL ;5/14/2012 "RTN","DVBA181P",2,0) ;;2.7;AMIE;**181**;Apr 10, 1995;Build 38 "RTN","DVBA181P",3,0) ; "RTN","DVBA181P",4,0) Q ;NO DIRECT ENTRY "RTN","DVBA181P",5,0) ; "RTN","DVBA181P",6,0) ENV ;Main entry point for Environment check point. "RTN","DVBA181P",7,0) ; "RTN","DVBA181P",8,0) Q "RTN","DVBA181P",9,0) ; "RTN","DVBA181P",10,0) ; "RTN","DVBA181P",11,0) PRE ;Main entry point for Pre-init items. "RTN","DVBA181P",12,0) ; "RTN","DVBA181P",13,0) Q "RTN","DVBA181P",14,0) ; "RTN","DVBA181P",15,0) ; "RTN","DVBA181P",16,0) POST ;Main entry point for Post-init items. "RTN","DVBA181P",17,0) ; "RTN","DVBA181P",18,0) D POST1 ;Populate Virtual VA parameter definitions "RTN","DVBA181P",19,0) D POST2 ;Edit AMIE EXAM file DBQ entries "RTN","DVBA181P",20,0) Q "RTN","DVBA181P",21,0) ; "RTN","DVBA181P",22,0) POST1 ;Populate new Virtual VA parameter definitions "RTN","DVBA181P",23,0) ; "RTN","DVBA181P",24,0) N DVBERR "RTN","DVBA181P",25,0) D BMES^XPDUTL("*************************") "RTN","DVBA181P",26,0) D MES^XPDUTL("Start Parameter Updates") "RTN","DVBA181P",27,0) D MES^XPDUTL("*************************") "RTN","DVBA181P",28,0) ; "RTN","DVBA181P",29,0) S DVBERR=$$ENXPAR("PKG","DVBAB CAPRI VIRTUALVA PROD URL","https://vbaphi8popp.vba.va.gov:7002/VABFI/services/vva") "RTN","DVBA181P",30,0) D UPDMSG("DVBAB CAPRI VIRTUALVA PROD URL",DVBERR) "RTN","DVBA181P",31,0) ; "RTN","DVBA181P",32,0) S DVBERR=$$ENXPAR("PKG","DVBAB CAPRI VIRTUALVA TEST URL","https://vbaphi5topp.vba.va.gov:7002/VABFI/services/vva") "RTN","DVBA181P",33,0) D UPDMSG("DVBAB CAPRI VIRTUALVA TEST URL",DVBERR) "RTN","DVBA181P",34,0) ; "RTN","DVBA181P",35,0) S DVBERR=$$ENXPAR("PKG","DVBAB CAPRI VVA USER","CAPRI") "RTN","DVBA181P",36,0) D UPDMSG("DVBAB CAPRI VVA USER",DVBERR) "RTN","DVBA181P",37,0) ; "RTN","DVBA181P",38,0) S DVBERR=$$ENXPAR("PKG","DVBAB CAPRI VVA TEST PASSWD","XXXXX") "RTN","DVBA181P",39,0) D UPDMSG("DVBAB CAPRI VVA TEST PASSWD",DVBERR) "RTN","DVBA181P",40,0) ; "RTN","DVBA181P",41,0) S DVBERR=$$ENXPAR("PKG","DVBAB CAPRI VVA PROD PASSWD","Passw0rd1") "RTN","DVBA181P",42,0) D UPDMSG("DVBAB CAPRI VVA PROD PASSWD",DVBERR) "RTN","DVBA181P",43,0) ; "RTN","DVBA181P",44,0) S DVBERR=$$ENXPAR("PKG","DVBAB CAPRI VVA TEST TOKEN","Username-1") "RTN","DVBA181P",45,0) D UPDMSG("DVBAB CAPRI VVA TEST TOKEN",DVBERR) "RTN","DVBA181P",46,0) ; "RTN","DVBA181P",47,0) S DVBERR=$$ENXPAR("PKG","DVBAB CAPRI VVA PROD TOKEN","Username-1") "RTN","DVBA181P",48,0) D UPDMSG("DVBAB CAPRI VVA PROD TOKEN",DVBERR) "RTN","DVBA181P",49,0) ; "RTN","DVBA181P",50,0) D MES^XPDUTL("*************************") "RTN","DVBA181P",51,0) D MES^XPDUTL("End Parameter Updates") "RTN","DVBA181P",52,0) D MES^XPDUTL("*************************") "RTN","DVBA181P",53,0) Q "RTN","DVBA181P",54,0) ; "RTN","DVBA181P",55,0) ENXPAR(DVBENT,DVBPAR,DVBVAL) ;Update Parameter values "RTN","DVBA181P",56,0) ; "RTN","DVBA181P",57,0) ; Input: "RTN","DVBA181P",58,0) ; DVBENT - Parameter Entity "RTN","DVBA181P",59,0) ; DVBPAR - Parameter Name "RTN","DVBA181P",60,0) ; DVBVAL - Parameter Value "RTN","DVBA181P",61,0) ; "RTN","DVBA181P",62,0) ; Output: "RTN","DVBA181P",63,0) ; Function value - returns "0" on success; "RTN","DVBA181P",64,0) ; otherwise returns error#^errortext "RTN","DVBA181P",65,0) ; "RTN","DVBA181P",66,0) N DVBERR "RTN","DVBA181P",67,0) D EN^XPAR(DVBENT,DVBPAR,1,DVBVAL,.DVBERR) "RTN","DVBA181P",68,0) Q DVBERR "RTN","DVBA181P",69,0) ; "RTN","DVBA181P",70,0) UPDMSG(DVBPAR,DVBERR) ;display update message "RTN","DVBA181P",71,0) ; "RTN","DVBA181P",72,0) ; Input: "RTN","DVBA181P",73,0) ; DVBPAR - Parameter Name "RTN","DVBA181P",74,0) ; DVBERR - Parameter Update result "RTN","DVBA181P",75,0) ; "RTN","DVBA181P",76,0) ; Output: none "RTN","DVBA181P",77,0) ; "RTN","DVBA181P",78,0) I DVBERR D "RTN","DVBA181P",79,0) . D MES^XPDUTL(DVBPAR_" update FAILURE.") "RTN","DVBA181P",80,0) . D MES^XPDUTL(" Failure reason: "_DVBERR) "RTN","DVBA181P",81,0) E D "RTN","DVBA181P",82,0) . D MES^XPDUTL(DVBPAR_" update SUCCESS.") "RTN","DVBA181P",83,0) Q "RTN","DVBA181P",84,0) ; "RTN","DVBA181P",85,0) POST2 ;Edit AMIE EXAM file DBQ entries "RTN","DVBA181P",86,0) ; "RTN","DVBA181P",87,0) ;Update active DBQ worksheet updates "RTN","DVBA181P",88,0) ; "RTN","DVBA181P",89,0) ; "RTN","DVBA181P",90,0) D BMES^XPDUTL(" *** RENAMING ACTIVE DBQ AMIE EXAM FILE ENTRIES ***") "RTN","DVBA181P",91,0) I '$D(^DVB(396.6)) D BMES^XPDUTL("Missing AMIE EXAM (#396.6) file") Q "RTN","DVBA181P",92,0) I $D(^DVB(396.6)) D STARTRN "RTN","DVBA181P",93,0) Q "RTN","DVBA181P",94,0) ; "RTN","DVBA181P",95,0) ; "RTN","DVBA181P",96,0) STARTRN ;Rename existing DBQ exam file entries "RTN","DVBA181P",97,0) ; "RTN","DVBA181P",98,0) N DVBAI,DVBLINE,DVBIEN,DVBEXMO,DVBEXMN "RTN","DVBA181P",99,0) ; "RTN","DVBA181P",100,0) D BMES^XPDUTL("Renaming AMIE EXAM (#396.6) file entries...") "RTN","DVBA181P",101,0) F DVBAI=1:1 S DVBLINE=$P($T(EXOLDNEW+DVBAI),";;",2) Q:DVBLINE="QUIT" D "RTN","DVBA181P",102,0) . S DVBIEN=$P(DVBLINE,";",1) ;ien "RTN","DVBA181P",103,0) . S DVBEXMO=$P(DVBLINE,";",2) ;old exam name "RTN","DVBA181P",104,0) . S DVBEXMN=$P(DVBLINE,";",3) ;new exam name "RTN","DVBA181P",105,0) . D RENEXAM "RTN","DVBA181P",106,0) Q "RTN","DVBA181P",107,0) ; "RTN","DVBA181P",108,0) RENEXAM ; "RTN","DVBA181P",109,0) ;Quit if critical variables missing "RTN","DVBA181P",110,0) I $G(DVBIEN)'>0!($G(DVBEXMO)']"")!($G(DVBEXMN)']"") D Q "RTN","DVBA181P",111,0) . D BMES^XPDUTL("Insufficient data to process change at #"_DVBIEN_")") "RTN","DVBA181P",112,0) ; "RTN","DVBA181P",113,0) ; Update existing entry "RTN","DVBA181P",114,0) ; "RTN","DVBA181P",115,0) N DVBAERR,DVBAFDA "RTN","DVBA181P",116,0) ; "RTN","DVBA181P",117,0) ; Check for existing entry "RTN","DVBA181P",118,0) I $G(^DVB(396.6,DVBIEN,0))']"" D Q "RTN","DVBA181P",119,0) . D BMES^XPDUTL("No entry found at #"_DVBIEN) "RTN","DVBA181P",120,0) ; "RTN","DVBA181P",121,0) ; Check for previous update "RTN","DVBA181P",122,0) I $P(^DVB(396.6,DVBIEN,0),"^",1)=DVBEXMN D Q "RTN","DVBA181P",123,0) . D BMES^XPDUTL("Entry at ien #"_DVBIEN_" has previously been updated") "RTN","DVBA181P",124,0) ; "RTN","DVBA181P",125,0) ; Check for correct entry NAME to update "RTN","DVBA181P",126,0) I $P(^DVB(396.6,DVBIEN,0),"^",1)'=DVBEXMO D Q "RTN","DVBA181P",127,0) . D BMES^XPDUTL("Entry at ien #"_DVBIEN_" does not match expected name "_DVBEXMO_" No updating will take place") "RTN","DVBA181P",128,0) ; "RTN","DVBA181P",129,0) ; Update entry "RTN","DVBA181P",130,0) S DVBAFDA(396.6,+DVBIEN_",",.01)=$G(DVBEXMN) "RTN","DVBA181P",131,0) D FILE^DIE("","DVBAFDA","DVBAERR") "RTN","DVBA181P",132,0) ; "RTN","DVBA181P",133,0) ; Report sucessful update "RTN","DVBA181P",134,0) ; "RTN","DVBA181P",135,0) I $D(DVBAERR("DIERR"))'>0 D Q "RTN","DVBA181P",136,0) . D BMES^XPDUTL("Renamed entry #"_DVBIEN_" from "_DVBEXMO_" to "_DVBEXMN) "RTN","DVBA181P",137,0) ; "RTN","DVBA181P",138,0) ; Report update error "RTN","DVBA181P",139,0) ; "RTN","DVBA181P",140,0) I $D(DVBAERR("DIERR"))>0 D "RTN","DVBA181P",141,0) . D BMES^XPDUTL(" *** Warning - Unable to update entry #"_DVBIEN_" *** ") "RTN","DVBA181P",142,0) . D MSG^DIALOG() "RTN","DVBA181P",143,0) Q "RTN","DVBA181P",144,0) ; "RTN","DVBA181P",145,0) ; **************************************************************************** "RTN","DVBA181P",146,0) ; AMIE EXAM (#396.6) file exam(s) to rename. Data should be in internal format. "RTN","DVBA181P",147,0) ; Format: ;;ien;"old" exam name(up to 60 chars);"new" exam name(up to 60 chars) "RTN","DVBA181P",148,0) ; "RTN","DVBA181P",149,0) ; **************************************************************************** "RTN","DVBA181P",150,0) EXOLDNEW ; "RTN","DVBA181P",151,0) ;;377;DBQ ENDOCRINE DISEASES OTHER THAN DIABETES;DBQ ENDO Endocrine miscellaneous "RTN","DVBA181P",152,0) ;;378;DBQ THYROID & PARATHYROID;DBQ ENDO Thyroid & parathyroid "RTN","DVBA181P",153,0) ;;379;DBQ CRANIAL NERVES;DBQ NEURO Cranial nerves "RTN","DVBA181P",154,0) ;;380;DBQ NARCOLEPSY;DBQ NEURO Narcolepsy "RTN","DVBA181P",155,0) ;;381;DBQ FIBROMYALGIA;DBQ NEURO Fibromyalgia "RTN","DVBA181P",156,0) ;;382;DBQ SEIZURE DISORDERS (EPILEPSY);DBQ NEURO Seizure disorders (Epilepsy) "RTN","DVBA181P",157,0) ;;383;DBQ URINARY TRACT AND BLADDER;DBQ GU Urinary tract (bladder and urethra) "RTN","DVBA181P",158,0) ;;384;DBQ ABDOMINAL, INGUINAL, AND FEMORAL HERNIAS;DBQ GEN SURG Hernia inguinal, femoral & abdom (not hiatal) "RTN","DVBA181P",159,0) ;;385;DBQ HIV-RELATED ILLNESS;DBQ INFECT HIV related illness "RTN","DVBA181P",160,0) ;;386;DBQ INFECTIOUS DISEASES;DBQ INFECT Infectious diseases "RTN","DVBA181P",161,0) ;;387;DBQ SYSTEMATIC LUPUS ERYTHEMATOUS (SLE) & OTHER IMMUNE DISOR;DBQ RHEUM Systemic lupus erythematosus "RTN","DVBA181P",162,0) ;;388;DBQ NUTRITIONAL DEFICIENCIES;DBQ NUTRI Nutritional deficiencies "RTN","DVBA181P",163,0) ;;389;DBQ ORAL AND DENTAL;DBQ DENTAL Dental & oral (other than TMJ) "RTN","DVBA181P",164,0) ;;390;DBQ LOSS OF SENSE OF SMELL AND TASTE;DBQ ENT Loss of sense of smell & taste "RTN","DVBA181P",165,0) ;;391;DBQ SINUSITIS/RHINITIS AND OTHER DISEASE OF THE NOSE, THROAT;DBQ ENT Sinusitis, rhinitis & other ENT conditions "RTN","DVBA181P",166,0) ;;392;DBQ RESPIRATORY CONDITIONS;DBQ RESP Respiratory conditions "RTN","DVBA181P",167,0) ;;393;DBQ CHRONIC FATIGUE SYNDROME;DBQ RHEUM Chronic fatigue syndrome "RTN","DVBA181P",168,0) ;;394;DBQ INITIAL EVALUATION OF RESIDUALS OF TBI (I-TBI);DBQ NEURO TBI Initial "RTN","DVBA181P",169,0) ;;395;DBQ REVIEW EVALUATION OF RESIDUALS OF TBI (R-TBI);DBQ NEURO TBI Review "RTN","DVBA181P",170,0) ;;396;DBQ GENERAL MEDICAL EXAM - COMPENSATION;DBQ General Medical Compensation "RTN","DVBA181P",171,0) ;;397;DBQ GENERAL PENSION EXAM;DBQ General Medical Pension "RTN","DVBA181P",172,0) ;;398;DBQ COLD INJURY RESIDUALS;DBQ Cold injury residuals "RTN","DVBA181P",173,0) ;;399;DBQ PRISONER OF WAR PROTOCOL;DBQ Prisoner of War (POW) "RTN","DVBA181P",174,0) ;;400;DBQ GULF WAR GENERAL MEDICAL EXAMINATION;DBQ General Medical Gulf War "RTN","DVBA181P",175,0) ;;401;DBQ AMPUTATIONS;DBQ MUSC Amputations "RTN","DVBA181P",176,0) ;;403;DBQ AMYOTROPHIC LATERAL SCLEROSIS (LOU GEHRIG'S DISEASE);DBQ NEURO Amyotrophic lateral sclerosis "RTN","DVBA181P",177,0) ;;404;DBQ ANKLE CONDITIONS;DBQ MUSC Ankle "RTN","DVBA181P",178,0) ;;405;DBQ ARTERY AND VEIN CONDITIONS;DBQ CARDIO Arteries & veins (vascular) "RTN","DVBA181P",179,0) ;;406;DBQ BACK (THORACOLUMBAR SPINE) CONDITIONS;DBQ MUSC Back (thoracolumbar spine) "RTN","DVBA181P",180,0) ;;407;DBQ BREAST CONDITIONS AND DISORDERS;DBQ GYN Breast conditions and disorders "RTN","DVBA181P",181,0) ;;408;DBQ CENTRAL NERVOUS SYSTEM DISEASES;DBQ NEURO Central nervous system "RTN","DVBA181P",182,0) ;;409;DBQ DIABETES MELLITUS;DBQ ENDO Diabetes mellitus "RTN","DVBA181P",183,0) ;;410;DBQ DIABETIC SENSORY-MOTOR PERIPHERAL NEUROPATHY;DBQ NEURO Diabetic sensory-motor peripheral neuropathy "RTN","DVBA181P",184,0) ;;411;DBQ EAR CONDITIONS;DBQ ENT Ear conditions "RTN","DVBA181P",185,0) ;;412;DBQ EATING DISORDERS;DBQ PSYCH Eating disorders "RTN","DVBA181P",186,0) ;;413;DBQ ELBOW AND FOREARM CONDITIONS;DBQ MUSC Elbow & forearm "RTN","DVBA181P",187,0) ;;414;DBQ ESOPHAGEAL CONDITIONS;DBQ GI Esophagus (including GERD & hiatal hernia) "RTN","DVBA181P",188,0) ;;415;DBQ EYE CONDITIONS;DBQ OPHTH Eye "RTN","DVBA181P",189,0) ;;416;DBQ FLATFOOT (PES PLANUS);DBQ MUSC Flatfoot (pes planus) "RTN","DVBA181P",190,0) ;;417;DBQ FOOT MISCELLANEOUS (OTHER THAN FLATFOOT PES PLANUS);DBQ MUSC Foot miscellaneous "RTN","DVBA181P",191,0) ;;418;DBQ GALLBLADDER AND PANCREAS CONDITIONS;DBQ GI Gallbladder & pancreas "RTN","DVBA181P",192,0) ;;419;DBQ GYNECOLOGICAL CONDITIONS;DBQ GYN Gynecological conditions "RTN","DVBA181P",193,0) ;;420;DBQ HAIRY CELL AND OTHER B CELL LEUKEMIAS;DBQ HEM Hairy Cell & other B-cell leukemias "RTN","DVBA181P",194,0) ;;421;DBQ HAND AND FINGER CONDITIONS;DBQ MUSC Hand & finger "RTN","DVBA181P",195,0) ;;422;DBQ HEADACHES (INCLUDING MIGRAINE HEADACHES);DBQ NEURO Headaches (including migraine headaches) "RTN","DVBA181P",196,0) ;;423;DBQ HEARING LOSS AND TINNITUS;DBQ AUDIO Hearing loss & tinnitus "RTN","DVBA181P",197,0) ;;424;DBQ HEART CONDITIONS;DBQ CARDIO Heart "RTN","DVBA181P",198,0) ;;425;DBQ HEMIC AND LYMPHATIC CONDITIONS INCLUDING LEUKEMIA;DBQ HEM Hemic & lymphatic, including leukemia "RTN","DVBA181P",199,0) ;;426;DBQ HEPATITIS, CIRRHOSIS AND OTHER LIVER CONDITIONS;DBQ GI Liver conditions Hepatitis, cirrhosis & other liver "RTN","DVBA181P",200,0) ;;427;DBQ HIP AND THIGH CONDITIONS;DBQ MUSC Hip & thigh "RTN","DVBA181P",201,0) ;;428;DBQ HYPERTENSION;DBQ CARDIO Hypertension "RTN","DVBA181P",202,0) ;;429;DBQ INFECTIOUS INTESTINAL DISORDERS;DBQ GI Intestines (infectious) "RTN","DVBA181P",203,0) ;;430;DBQ INITIAL PTSD;DBQ PSYCH PTSD Initial "RTN","DVBA181P",204,0) ;;431;DBQ INTESTINAL (OTHER THAN SURGICAL OR INFECTIOUS);DBQ GI Intestines (other than surgical or infectious) "RTN","DVBA181P",205,0) ;;432;DBQ INTESTINAL SURGERY (RESECTION, COLOSTOMY, ILEOSTOMY);DBQ GI Intestines (surgical) "RTN","DVBA181P",206,0) ;;433;DBQ ISCHEMIC HEART DISEASE;DBQ CARDIO Ischemic heart disease "RTN","DVBA181P",207,0) ;;434;DBQ KIDNEY CONDITIONS (NEPHROLOGY);DBQ GU Kidney (nephrology) "RTN","DVBA181P",208,0) ;;435;DBQ KNEE AND LOWER LEG CONDITIONS;DBQ MUSC Knee & lower leg "RTN","DVBA181P",209,0) ;;436;DBQ MALE REPRODUCTIVE SYSTEM CONDITIONS;DBQ GU Male reproductive system "RTN","DVBA181P",210,0) ;;437;DBQ MEDICAL OPINION 1;DBQ Medical Opinion 1 "RTN","DVBA181P",211,0) ;;438;DBQ MEDICAL OPINION 2;DBQ Medical Opinion 2 "RTN","DVBA181P",212,0) ;;439;DBQ MEDICAL OPINION 3;DBQ Medical Opinion 3 "RTN","DVBA181P",213,0) ;;440;DBQ MEDICAL OPINION 4;DBQ Medical Opinion 4 "RTN","DVBA181P",214,0) ;;441;DBQ MEDICAL OPINION 5;DBQ Medical Opinion 5 "RTN","DVBA181P",215,0) ;;442;DBQ MENTAL DISORDERS (EXCEPT PTSD AND EATING DISORDERS);DBQ PSYCH Mental disorders "RTN","DVBA181P",216,0) ;;443;DBQ MULTIPLE SCLEROSIS (MS);DBQ NEURO Multiple sclerosis "RTN","DVBA181P",217,0) ;;444;DBQ MUSCLE INJURIES;DBQ MUSC Muscle injuries "RTN","DVBA181P",218,0) ;;445;DBQ NECK (CERVICAL SPINE) CONDITIONS;DBQ MUSC Neck (cervical spine) "RTN","DVBA181P",219,0) ;;446;DBQ NON-DEGENERATIVE ARTHRITIS;DBQ RHEUM Arthritis: non-degen (inflam, imm, cryst, infect) "RTN","DVBA181P",220,0) ;;447;DBQ OSTEOMYELITIS;DBQ MUSC Osteomyelitis "RTN","DVBA181P",221,0) ;;448;DBQ PARKINSONS;DBQ NEURO Parkinsons disease "RTN","DVBA181P",222,0) ;;449;DBQ PERIPHERAL NERVES (EXCLUDING DIABETIC NEUROPATHY);DBQ NEURO Peripheral nerves "RTN","DVBA181P",223,0) ;;450;DBQ PERITONEAL ADHESIONS;DBQ GI Peritoneal adhesion "RTN","DVBA181P",224,0) ;;451;DBQ PERSIAN GULF AND AFGHANISTAN INFECTIOUS DISEASES;DBQ INFECT South West Asia Infectious diseases "RTN","DVBA181P",225,0) ;;452;DBQ PROSTATE CANCER;DBQ GU Prostate cancer "RTN","DVBA181P",226,0) ;;453;DBQ RECTUM AND ANUS CONDITIONS;DBQ GEN SURG Rectum & anus (including hemorrhoids) "RTN","DVBA181P",227,0) ;;454;DBQ REVIEW PTSD;DBQ PSYCH PTSD Review "RTN","DVBA181P",228,0) ;;455;DBQ SCARS DISFIGUREMENT;DBQ DERM Scars "RTN","DVBA181P",229,0) ;;456;DBQ SHOULDER AND ARM CONDITIONS;DBQ MUSC Shoulder & arm "RTN","DVBA181P",230,0) ;;457;DBQ SKIN DISEASES;DBQ DERM Skin "RTN","DVBA181P",231,0) ;;458;DBQ SLEEP APNEA;DBQ RESP Sleep apnea "RTN","DVBA181P",232,0) ;;459;DBQ STOMACH AND DUODENAL CONDITIONS;DBQ GI Stomach & duodenum "RTN","DVBA181P",233,0) ;;460;DBQ TEMPOROMANDIBULAR JOINT (TMJ) CONDITIONS;DBQ MUSC Temporomandibular joint "RTN","DVBA181P",234,0) ;;461;DBQ TUBERCULOSIS;DBQ INFECT Tuberculosis "RTN","DVBA181P",235,0) ;;462;DBQ WRIST CONDITIONS;DBQ MUSC Wrist "RTN","DVBA181P",236,0) ;;QUIT "RTN","DVBA8861") 0^6^B137760050^n/a "RTN","DVBA8861",1,0) DVBA8861 ;ALB/DJS - STATUS REPORT OF 8861 REQUESTS FOR MEDICAL SERVICES, CHAPTER 31 ; 8/8/12 4:48pm "RTN","DVBA8861",2,0) ;;2.7;AMIE;**181**;Apr 10, 1995;Build 38 "RTN","DVBA8861",3,0) ; "RTN","DVBA8861",4,0) Q ;no direct entry "RTN","DVBA8861",5,0) ; "RTN","DVBA8861",6,0) STATRPT(BDATE,EDATE,RORPT,DVBSTAT,DLMTR) ; entry point of 8861 report "RTN","DVBA8861",7,0) ; "RTN","DVBA8861",8,0) ; Input: "RTN","DVBA8861",9,0) ; BDATE - beginning date for report "RTN","DVBA8861",10,0) ; EDATE - ending date for report "RTN","DVBA8861",11,0) ; RORPT - regional office to report on or "ALL" "RTN","DVBA8861",12,0) ; DVBSTAT - requested status for report "RTN","DVBA8861",13,0) ; DLMTR - delimiter indicator (0=no;1=yes) "RTN","DVBA8861",14,0) ; "RTN","DVBA8861",15,0) N EXBDAT ;beginning date "RTN","DVBA8861",16,0) N EXEDAT ;end date "RTN","DVBA8861",17,0) N EXSTAT ;request status "RTN","DVBA8861",18,0) N DVBRS ;request status conversion results "RTN","DVBA8861",19,0) N REQERR ;Fileman error message "RTN","DVBA8861",20,0) N REQCNT ;number of found records "RTN","DVBA8861",21,0) ; "RTN","DVBA8861",22,0) K ^TMP("VOCREQ",$J) "RTN","DVBA8861",23,0) S EXBDAT=$$FMTE^XLFDT(BDATE,"5DZ") "RTN","DVBA8861",24,0) S EXEDAT=$$FMTE^XLFDT(EDATE,"5DZ") "RTN","DVBA8861",25,0) I DVBSTAT="A" S EXSTAT="ALL" "RTN","DVBA8861",26,0) E D "RTN","DVBA8861",27,0) . D CHK^DIE(396.9,13,"E",DVBSTAT,.DVBRS,"REQERR") "RTN","DVBA8861",28,0) . S EXSTAT=$G(DVBRS(0)) "RTN","DVBA8861",29,0) S (REQCNT,TOTPEND,AVGPEND,TOTCMPL,AVGCMPL)=0 "RTN","DVBA8861",30,0) F STAT="C","N","P","X" S CNT(STAT)=0 "RTN","DVBA8861",31,0) ; "RTN","DVBA8861",32,0) ; find records matching search criteria "RTN","DVBA8861",33,0) D FINDRECS(BDATE,EDATE,RORPT,DVBSTAT,.REQCNT) "RTN","DVBA8861",34,0) ; "RTN","DVBA8861",35,0) ; output results "RTN","DVBA8861",36,0) I 'REQCNT D "RTN","DVBA8861",37,0) . W "NO DATA FOUND" "RTN","DVBA8861",38,0) E D "RTN","DVBA8861",39,0) . S RGNLOFC=$$SITE^VASITE,SITE=$P(RGNLOFC,U,2)_" ("_$P(RGNLOFC,U,3)_")" S:RORPT="ALL" ROREPRT="ALL" "RTN","DVBA8861",40,0) . S:RORPT'="ALL" RO4RPT=$$NS^XUAF4(RORPT),ROREPRT=$P(RO4RPT,U,1)_" ("_$P(RO4RPT,U,2)_")" "RTN","DVBA8861",41,0) . I 'DLMTR D HEADER(EXBDAT,EXEDAT,EXSTAT),PRINTND,NDTOTAL ;print non-delimited records & totals "RTN","DVBA8861",42,0) . I DLMTR D DLMTHDR(EXBDAT,EXEDAT,EXSTAT),PRTDLMT,DLMTOTL ;print delimited records & totals "RTN","DVBA8861",43,0) K ^TMP("VOCREQ",$J) "RTN","DVBA8861",44,0) D KILL "RTN","DVBA8861",45,0) Q "RTN","DVBA8861",46,0) ; "RTN","DVBA8861",47,0) FINDRECS(BDAT,EDAT,RORPT,DVBSTAT,CNT) ; find record matches "RTN","DVBA8861",48,0) ; "RTN","DVBA8861",49,0) ; Input: "RTN","DVBA8861",50,0) ; BDAT - beginning date for report "RTN","DVBA8861",51,0) ; EDAT - ending date for report "RTN","DVBA8861",52,0) ; RORPT - regional office to report on or "ALL" "RTN","DVBA8861",53,0) ; DVBSTAT - requested status (internal format) "RTN","DVBA8861",54,0) ; CNT - record count "RTN","DVBA8861",55,0) ; "RTN","DVBA8861",56,0) N REQIEN ; 8861 Request IEN "RTN","DVBA8861",57,0) N FLDS ; field array in external format "RTN","DVBA8861",58,0) ; "RTN","DVBA8861",59,0) S STAT="",(DONE,DONE2)=0 "RTN","DVBA8861",60,0) F S STAT=$O(^DVB(396.9,"ARSDT",STAT)) Q:STAT="" I (STAT=DVBSTAT)!(DVBSTAT="A") D "RTN","DVBA8861",61,0) . S REQDT=BDATE "RTN","DVBA8861",62,0) . F S REQDT=$O(^DVB(396.9,"ARSDT",STAT,REQDT)) S RQSTDT=$P(REQDT,".") S:REQDT="" DONE=1 Q:(DONE&(REQDT=""))!(RQSTDT>EDATE)!(REQDT0 S APPTDT="" F S APPTDT=$O(^TMP($J,"SDAMA301",DFN,APPTDT)) Q:APPTDT']"" S APPTDT1=$G(^TMP($J,"SDAMA301",DFN,APPTDT,0)) Q:APPTDT1']"" D "RTN","DVBA8861",147,0) . . . . . S CNSLT=+$G(DVBCNARR(396.914,CONIENS,.01,"I")),CNSLTLNK=$P(APPTDT1,U,6) Q:('$G(CNSLTLNK)!(CNSLT'=CNSLTLNK)) "RTN","DVBA8861",148,0) . . . . . S REQFLDS("APPTDT")=$$FMTE^XLFDT(APPTDT,"2DZ") "RTN","DVBA8861",149,0) . . . . . S APPTDAYS=+$$FMDIFF^XLFDT(APPTDT,REQDT),REQFLDS("APPTDAYS")=APPTDAYS "RTN","DVBA8861",150,0) . . . . . K ^TMP($J,"SDAMA301") "RTN","DVBA8861",151,0) . . . . Q "RTN","DVBA8861",152,0) . . . Q "RTN","DVBA8861",153,0) . . Q "RTN","DVBA8861",154,0) . S REQFLDS("PENDING")=0 ; do not calculate number of days pending unless status="P" (below) "RTN","DVBA8861",155,0) . I STAT="P"&($G(CNSLDT)'="") S PENDING=+$$FMDIFF^XLFDT(TODAY,CNSLDT),REQFLDS("PENDING")=PENDING,TOTPEND=TOTPEND+PENDING "RTN","DVBA8861",156,0) . S RPTSTAT=STAT "RTN","DVBA8861",157,0) . S REQRSLT=1 "RTN","DVBA8861",158,0) Q REQRSLT "RTN","DVBA8861",159,0) ; "RTN","DVBA8861",160,0) ERR() ; Process error message. "RTN","DVBA8861",161,0) N APPTERR "RTN","DVBA8861",162,0) S APPTERR=0 "RTN","DVBA8861",163,0) I $D(^TMP($J,"SDAMA301",101)) D "RTN","DVBA8861",164,0) . S APPTERR=101_"^"_" *** RSA: Process DATABASE IS UNAVAILABLE ***" "RTN","DVBA8861",165,0) I $D(^TMP($J,"SDAMA301",115)) D "RTN","DVBA8861",166,0) . S APPTERR=115_"^"_" *** RSA: Appointment request filter contains invalid values ***" "RTN","DVBA8861",167,0) I $D(^TMP($J,"SDAMA301",116)) D "RTN","DVBA8861",168,0) . S APPTERR=116_"^"_" *** RSA: Data doesn't exist error has occurred ***" "RTN","DVBA8861",169,0) I $D(^TMP($J,"SDAMA301",117)) D "RTN","DVBA8861",170,0) . S APPTERR=117_"^"_" *** RSA: Other undefined error has occurred ***" "RTN","DVBA8861",171,0) Q APPTERR "RTN","DVBA8861",172,0) ; "RTN","DVBA8861",173,0) DLMTHDR(EXBDAT,EXEDAT,EXSTAT) ;output delimited format header "RTN","DVBA8861",174,0) ; "RTN","DVBA8861",175,0) ; Input: "RTN","DVBA8861",176,0) ; EXBDAT - beginning date (external format) "RTN","DVBA8861",177,0) ; EXEDAT - ending date (external format) "RTN","DVBA8861",178,0) ; EXSTAT - request status (external format) "RTN","DVBA8861",179,0) ; "RTN","DVBA8861",180,0) W "8861 Request for Medical Services, Chapter 31 Status Report" "RTN","DVBA8861",181,0) W !,"Date Range: "_EXBDAT_" - "_EXEDAT "RTN","DVBA8861",182,0) W !,"Regional Office: ",ROREPRT," for site: ",SITE "RTN","DVBA8861",183,0) W !,"Request Status: ",EXSTAT "RTN","DVBA8861",184,0) W !,"DateReceived^ReqStat^PatientName^SSN^POCName^POCLocation^PendDays^CnclDays^Consults^ApptDays^ApptDate^ConsultDate" "RTN","DVBA8861",185,0) Q "RTN","DVBA8861",186,0) ; "RTN","DVBA8861",187,0) PRTDLMT ; output delimited format details "RTN","DVBA8861",188,0) ; "RTN","DVBA8861",189,0) N REGOFF ; regional office - sort criteria "RTN","DVBA8861",190,0) N VOCG ; generic counter "RTN","DVBA8861",191,0) ; "RTN","DVBA8861",192,0) S REGOFF="" "RTN","DVBA8861",193,0) F S REGOFF=$O(^TMP("VOCREQ",$J,REGOFF)) Q:REGOFF="" D "RTN","DVBA8861",194,0) . I RORPT="ALL" S RO4RPT=$$NS^XUAF4(REGOFF),REGOPRT=$S(REGOFF=0:"UNSPECIFIED",1:$P(RO4RPT,U,1)_" ("_$P(RO4RPT,U,2)_")") W !!!," Regional Office: " W REGOPRT,!?20 F I=1:1:$L(REGOPRT) W "-" "RTN","DVBA8861",195,0) . I DVBSTAT="A" F RSTAT="N","P","X","C" D DLM "RTN","DVBA8861",196,0) . E I DVBSTAT'="A" S RSTAT=RPTSTAT D DLM "RTN","DVBA8861",197,0) Q "RTN","DVBA8861",198,0) ; "RTN","DVBA8861",199,0) DLM ; write delimited detail data "RTN","DVBA8861",200,0) ; "RTN","DVBA8861",201,0) Q:'$D(^TMP("VOCREQ",$J,REGOFF,RSTAT)) "RTN","DVBA8861",202,0) I $D(^TMP("VOCREQ",$J,REGOFF,RSTAT)) W ! "RTN","DVBA8861",203,0) S NM="" "RTN","DVBA8861",204,0) F S NM=$O(^TMP("VOCREQ",$J,REGOFF,RSTAT,NM)) Q:NM="" D "RTN","DVBA8861",205,0) . S VOCG="" "RTN","DVBA8861",206,0) . F S VOCG=$O(^TMP("VOCREQ",$J,REGOFF,RSTAT,NM,VOCG)) Q:VOCG="" D "RTN","DVBA8861",207,0) . . I $P(^TMP("VOCREQ",$J,REGOFF,RSTAT,NM,VOCG),U,7)=0 S $P(^TMP("VOCREQ",$J,REGOFF,RSTAT,VOCG),U,7)="" ; don't print 0 days pending "RTN","DVBA8861",208,0) . . W !,^TMP("VOCREQ",$J,REGOFF,RSTAT,NM,VOCG) "RTN","DVBA8861",209,0) . . S CNT(RSTAT)=CNT(RSTAT)+1 "RTN","DVBA8861",210,0) Q "RTN","DVBA8861",211,0) ; "RTN","DVBA8861",212,0) DLMTOTL ; print totals in delimited format "RTN","DVBA8861",213,0) ; "RTN","DVBA8861",214,0) ; Input: "RTN","DVBA8861",215,0) ; AVGPEND - average days pending "RTN","DVBA8861",216,0) ; AVGCMPL - average days to complete "RTN","DVBA8861",217,0) ; "RTN","DVBA8861",218,0) S:TOTPEND AVGPEND=TOTPEND\CNT("P") S:TOTCMPL AVGCMPL=TOTCMPL\CNT("C") "RTN","DVBA8861",219,0) ; "RTN","DVBA8861",220,0) W !!,"Avg Days^Avg Days^New^Pending^Cancelled^Complete",! "RTN","DVBA8861",221,0) W "Totals for R.O.^Pending^Complete^Requests^Requests^Requests^Requests^Totals",! "RTN","DVBA8861",222,0) W ROREPRT_"^"_AVGPEND_"^"_AVGCMPL_"^"_$G(CNT("N"))_"^"_$G(CNT("P"))_"^"_$G(CNT("X"))_"^"_$G(CNT("C"))_"^"_REQCNT "RTN","DVBA8861",223,0) Q "RTN","DVBA8861",224,0) ; "RTN","DVBA8861",225,0) HEADER(EXBDAT,EXEDAT,EXSTAT) ; print plain format header "RTN","DVBA8861",226,0) ; "RTN","DVBA8861",227,0) ; Input: "RTN","DVBA8861",228,0) ; EXBDAT - beginning date (external format) "RTN","DVBA8861",229,0) ; EXEDAT - ending date (external format) "RTN","DVBA8861",230,0) ; EXSTAT - request status (external format) "RTN","DVBA8861",231,0) ; "RTN","DVBA8861",232,0) W "8861 Request for Medical Services, Chapter 31 Status Report" "RTN","DVBA8861",233,0) W !,"Date Range: ",EXBDAT," - ",EXEDAT "RTN","DVBA8861",234,0) W !,"Regional Office: ",ROREPRT," for site: ",SITE "RTN","DVBA8861",235,0) W !,"Request Status: ",EXSTAT "RTN","DVBA8861",236,0) W !!,"Date",?17,"Patient",?43,"POC",?59,"POC",?78,"Pend",?83,"Canc",?88,"Comp",?93,"Consult",?109,"Appt Appt",?122,"Consult" "RTN","DVBA8861",237,0) W !,"Received",?9,"Status",?17,"Name",?38,"SSN",?43,"Name",?59,"Location" "RTN","DVBA8861",238,0) W ?78,"Days",?83,"Days",?88,"Days",?93,"Service",?109,"Days Date",?122,"Date" "RTN","DVBA8861",239,0) Q "RTN","DVBA8861",240,0) ; "RTN","DVBA8861",241,0) PRINTND ; output plain format details "RTN","DVBA8861",242,0) ; "RTN","DVBA8861",243,0) N REGOFF ; regional office - sort criteria "RTN","DVBA8861",244,0) N VOCG ; generic counter "RTN","DVBA8861",245,0) ; "RTN","DVBA8861",246,0) S REGOFF="" "RTN","DVBA8861",247,0) F S REGOFF=$O(^TMP("VOCREQ",$J,REGOFF)) Q:REGOFF="" D "RTN","DVBA8861",248,0) . I RORPT="ALL" S RO4RPT=$$NS^XUAF4(REGOFF),REGOPRT=$S(REGOFF=0:"UNSPECIFIED",1:$P(RO4RPT,U,1)_" ("_$P(RO4RPT,U,2)_")") W !!!," Regional Office: " W REGOPRT,!?20 F I=1:1:$L(REGOPRT) W "-" "RTN","DVBA8861",249,0) . I DVBSTAT="A" F RSTAT="N","P","X","C" D ND1 "RTN","DVBA8861",250,0) . E I DVBSTAT'="A" S RSTAT=RPTSTAT D ND1 "RTN","DVBA8861",251,0) Q "RTN","DVBA8861",252,0) ; "RTN","DVBA8861",253,0) ND1 ; write plain detail data "RTN","DVBA8861",254,0) ; "RTN","DVBA8861",255,0) Q:'$D(^TMP("VOCREQ",$J,REGOFF,RSTAT)) "RTN","DVBA8861",256,0) I $D(^TMP("VOCREQ",$J,REGOFF,RSTAT)) W ! "RTN","DVBA8861",257,0) S NM="" "RTN","DVBA8861",258,0) F S NM=$O(^TMP("VOCREQ",$J,REGOFF,RSTAT,NM)) Q:NM="" D "RTN","DVBA8861",259,0) . S VOCG="" "RTN","DVBA8861",260,0) . F S VOCG=$O(^TMP("VOCREQ",$J,REGOFF,RSTAT,NM,VOCG)) Q:VOCG="" D "RTN","DVBA8861",261,0) . . S VOCREC=^TMP("VOCREQ",$J,REGOFF,RSTAT,NM,VOCG) "RTN","DVBA8861",262,0) . . S CNT(RSTAT)=CNT(RSTAT)+1 "RTN","DVBA8861",263,0) . . S REQDT=$P(VOCREC,U),REQSTAT=$E($P(VOCREC,U,2),1,4),PATIENT=$E($P(VOCREC,U,3),1,22),SSN=$P(VOCREC,U,4),LN=$L(SSN),SSN1=$E(SSN,LN-3,LN),POCNM=$E($P(VOCREC,U,5),1,15),POCLOC=$E($P(VOCREC,U,6),1,20) "RTN","DVBA8861",264,0) . . S PENDING=$P(VOCREC,U,7),CANCEL=$P(VOCREC,U,8),COMPLETE=$P(VOCREC,U,9),CNSTOSVC=$E($P(VOCREC,U,10),1,15),APPTDAYS=$P(VOCREC,U,11),APPTDT=$P(VOCREC,U,12),CNSLDT=$P(VOCREC,U,13) "RTN","DVBA8861",265,0) . . W !,REQDT,?10,REQSTAT,?15,PATIENT,?38,SSN1,?43,POCNM,?59,POCLOC "RTN","DVBA8861",266,0) . I PENDING W ?78,$J(PENDING,3) "RTN","DVBA8861",267,0) . I CANCEL W ?83,$J(CANCEL,3) "RTN","DVBA8861",268,0) . I COMPLETE W ?88,$J(COMPLETE,3) "RTN","DVBA8861",269,0) . W ?93,CNSTOSVC "RTN","DVBA8861",270,0) . I APPTDAYS W ?109,$J(APPTDAYS,2) "RTN","DVBA8861",271,0) . W ?113,APPTDT,?122,CNSLDT "RTN","DVBA8861",272,0) Q "RTN","DVBA8861",273,0) ; "RTN","DVBA8861",274,0) NDTOTAL ; print plain format totals section "RTN","DVBA8861",275,0) ; "RTN","DVBA8861",276,0) ; Input: "RTN","DVBA8861",277,0) ; AVGPEND - average days pending "RTN","DVBA8861",278,0) ; AVGCMPL - average days to complete "RTN","DVBA8861",279,0) ; "RTN","DVBA8861",280,0) S:(TOTPEND&$G(CNT("P"))) AVGPEND=TOTPEND\CNT("P") S:(TOTCMPL&$G(CNT("C"))) AVGCMPL=TOTCMPL\CNT("C") "RTN","DVBA8861",281,0) S REQCNT=$J(REQCNT,3) "RTN","DVBA8861",282,0) ; "RTN","DVBA8861",283,0) W !!!?27,"Avg Days",?37,"Avg Days",?46,"New",?56,"Pending",?66,"Cancelled",?77,"Complete" "RTN","DVBA8861",284,0) W !?3,"Totals for R.O.",?27,"Pending",?37,"Complete",?46,"Requests",?56,"Requests",?66,"Requests",?77,"Requests",?87,"Totals" "RTN","DVBA8861",285,0) W !!?2,ROREPRT,?30,AVGPEND,?41,AVGCMPL,?49,$G(CNT("N")),?59,$G(CNT("P")),?70,$G(CNT("X")),?80,$G(CNT("C")),?88,REQCNT,! "RTN","DVBA8861",286,0) Q "RTN","DVBA8861",287,0) ; "RTN","DVBA8861",288,0) KILL ; kill local variables "RTN","DVBA8861",289,0) ; "RTN","DVBA8861",290,0) K APPTARY,APPTDAYS,APPTDT,APPTDT1,APPTERR,ARRAY,AVGCMPL,AVGPEND,CANCEL,CANCLDT,CNSLDT,CNSLERR,CNSLIENS,CNSLT,CNSLTLNK,CNSLTS "RTN","DVBA8861",291,0) K CNSTOSVC,COMPLETE,COMPLTDT,CONIENS,DAYS2CMP,DONE,DONE2,DVBCNARR,DVBREQ,DVBRS,DVBSTAT,I,LN,NM,PATIENT,PENDING,POCLOC,POCNM,REGOPRT "RTN","DVBA8861",292,0) K REQDT,REQESTDT,REQIENS,RGNLOFC,RO,RO4RPT,ROREPRT,ROSTANM,RPTSTAT,RQSTDT,RSTAT,SITE,SSN,SSN1,STAT,TODAY,TOTCMPL,TOTPEND,VOCREC,X "RTN","DVBA8861",293,0) Q "RTN","DVBAB82") 0^2^B116645006^B109260107 "RTN","DVBAB82",1,0) DVBAB82 ;ALB/DJS - CAPRI DVBA REPORTS ; 01/24/12 "RTN","DVBAB82",2,0) ;;2.7;AMIE;**42,90,100,119,156,149,179,181**;Apr 10, 1995;Build 38 "RTN","DVBAB82",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","DVBAB82",4,0) Q "RTN","DVBAB82",5,0) ; "RTN","DVBAB82",6,0) START(MSG,RPID,PARM) ; CALLED BY REMOTE PROCEDURE DVBAB REPORTS "RTN","DVBAB82",7,0) ;Parameters "RTN","DVBAB82",8,0) ;============= "RTN","DVBAB82",9,0) ; MSG : Output - ^TMP("DVBA",$J) "RTN","DVBAB82",10,0) ; RPID : Report Identification Number "RTN","DVBAB82",11,0) ; PARM : Input parameters separated by "^" "RTN","DVBAB82",12,0) ; "RTN","DVBAB82",13,0) N DVBHFS,DVBERR,DVBGUI,I,DVBADLMTD "RTN","DVBAB82",14,0) K ^TMP("DVBA",$J) "RTN","DVBAB82",15,0) S DVBGUI=1,(DVBERR,DVBADLMTD)=0,DVBHFS=$$HFS(),RPID=$G(RPID) "RTN","DVBAB82",16,0) I RPID<1!(RPID>15) S DVBERR=1,^TMP("DVBA",$J,1)="0^Undefined Report ID" G END "RTN","DVBAB82",17,0) D HFSOPEN("DVBRP",DVBHFS,"W") I DVBERR G END "RTN","DVBAB82",18,0) I RPID=1 D CRMS G END "RTN","DVBAB82",19,0) I RPID=3 D CPRNT G END "RTN","DVBAB82",20,0) I RPID=11 D CNHRP G END ;FNCNH Print Roster "RTN","DVBAB82",21,0) D CHECK I DVBERR G END ;reports below require parameters "RTN","DVBAB82",22,0) I RPID=2 D CRRR G END "RTN","DVBAB82",23,0) I RPID=4 D CRPON G END "RTN","DVBAB82",24,0) I RPID=5 D CIRPT G END "RTN","DVBAB82",25,0) I RPID=6 D DSRP G END "RTN","DVBAB82",26,0) I RPID=7 D SDPP G END "RTN","DVBAB82",27,0) I RPID=8 D SPRPT G END "RTN","DVBAB82",28,0) I RPID=9 D VIEW G END "RTN","DVBAB82",29,0) I RPID=10 D CNHDEOC G END ;FBCNH Display Episode Of Care "RTN","DVBAB82",30,0) I RPID=12 D CNHRAD G END ;FNCNH Report of Admissions/Discharges "RTN","DVBAB82",31,0) I RPID=13 D CNHSE90D G END ;FNCNH Stays in Excess of 90 Days "RTN","DVBAB82",32,0) I RPID=14 D REQSTAT G END ;REQUEST STATUS BY DATE RANGE "RTN","DVBAB82",33,0) I RPID=15 D DVBA8861 G END ;FORM 28-8861 STATUS REPORT "RTN","DVBAB82",34,0) ; "RTN","DVBAB82",35,0) END D HFSCLOSE("DVBRP",DVBHFS) "RTN","DVBAB82",36,0) I ($G(DVBADLMTD)&('+DVBERR)) D Q ;Create delimited output if no errors "RTN","DVBAB82",37,0) .D DLMTRPT^DVBAB82D(RPID) "RTN","DVBAB82",38,0) .S MSG=$NA(^TMP("DVBADLMTD",$J)) "RTN","DVBAB82",39,0) ;Replace "##FFFF##" with Form Feeds - code needed for LINUX environments "RTN","DVBAB82",40,0) S I=0 F S I=$O(^TMP("DVBA",$J,1,I)) Q:'I D "RTN","DVBAB82",41,0) .S:^TMP("DVBA",$J,1,I)["##FFFF##" ^TMP("DVBA",$J,1,I)=$P(^TMP("DVBA",$J,1,I),"##FFFF##")_$C(13,12)_$P(^TMP("DVBA",$J,1,I),"##FFFF##",2) "RTN","DVBAB82",42,0) .S ^TMP("DVBA",$J,1,I)=^TMP("DVBA",$J,1,I)_$C(13) "RTN","DVBAB82",43,0) .S:^TMP("DVBA",$J,1,I)["$END" ^TMP("DVBA",$J,1,I)="" "RTN","DVBAB82",44,0) S MSG=$NA(^TMP("DVBA",$J)) "RTN","DVBAB82",45,0) Q "RTN","DVBAB82",46,0) CHECK ; VALIDATE INPUT PARAMETERS "RTN","DVBAB82",47,0) I $G(PARM)="" S DVBERR=1,^TMP("DVBA",$J,1)="0^Undefined Input Parameters" "RTN","DVBAB82",48,0) Q "RTN","DVBAB82",49,0) ; "RTN","DVBAB82",50,0) SDPP ; Report # 7 - Full (Patient Profile MAS) Report "RTN","DVBAB82",51,0) ;Parameters "RTN","DVBAB82",52,0) ;============= "RTN","DVBAB82",53,0) ; DFN : Patient Identification Number "RTN","DVBAB82",54,0) ; SDR : R/Range or A/All "RTN","DVBAB82",55,0) ; SDBD : Begining date "RTN","DVBAB82",56,0) ; SDED : Ending date "RTN","DVBAB82",57,0) ; SDP : Print the profile? 1 OR 0 "RTN","DVBAB82",58,0) ; SDTYP(2) : Print appointments? 1 OR 0 "RTN","DVBAB82",59,0) ; SDTYP(1) : Print add/edits? 1 or 0 "RTN","DVBAB82",60,0) ; SDTYP(4) : Print enrollments? 1 or 0 "RTN","DVBAB82",61,0) ; SDTYP(3) : Print dispositions? 1 OR 0 "RTN","DVBAB82",62,0) ; SDTYP(7) : Print team information? 1 OR 0 "RTN","DVBAB82",63,0) ; SDTYP(5) : Print means test? 1 OR 0 "RTN","DVBAB82",64,0) ; "RTN","DVBAB82",65,0) N SDTYP,SDBD,SDED,SDACT,SDPRINT,SDYES,SDRANGE,SDBEG,SDEN "RTN","DVBAB82",66,0) S ^XTMP("JAP",$J,$$NOW^XLFDT(),"SDPP")=PARM "RTN","DVBAB82",67,0) S DFN=$P(PARM,"^",1),SDR=$P(PARM,"^",2),SDBD=$P(PARM,"^",3),SDED=$P(PARM,"^",4) "RTN","DVBAB82",68,0) S SDP=$P(PARM,"^",5),SDTYP(2)=$P(PARM,"^",6),SDTYP(1)=$P(PARM,"^",7) "RTN","DVBAB82",69,0) S SDTYP(4)=$P(PARM,"^",8),SDTYP(3)=$P(PARM,"^",9),SDTYP(7)=$P(PARM,"^",10),SDTYP(5)=$P(PARM,"^",11) "RTN","DVBAB82",70,0) D VAL Q:DVBERR "RTN","DVBAB82",71,0) S SDACT="",(SDYES,SDRANGE,SDPRINT)=0 "RTN","DVBAB82",72,0) I SDR="R" S SDRANGE=1 "RTN","DVBAB82",73,0) I SDP=1 S SDYES=1,SDPRINT=1 "RTN","DVBAB82",74,0) I 'SDRANGE S (SDBD,SDBEG)=2800101,(SDED,SDEND)=$$ENDDT(),SDHDR=1 "RTN","DVBAB82",75,0) D ENS^%ZISS "RTN","DVBAB82",76,0) S SDPRINT=1 "RTN","DVBAB82",77,0) S:(SDTYP(2)=1) SDTYP(2)="" ;appointments "RTN","DVBAB82",78,0) K:(SDTYP(2)=0) SDTYP(2) "RTN","DVBAB82",79,0) S:(SDTYP(1)=1) SDTYP(1)="" ;add/edits "RTN","DVBAB82",80,0) K:(SDTYP(1)=0) SDTYP(1) "RTN","DVBAB82",81,0) I (SDTYP(4)=1) S SDTYP(4)="",SDACT=0 ;enrollments "RTN","DVBAB82",82,0) K:(SDTYP(4)=0) SDTYP(4) "RTN","DVBAB82",83,0) S:(SDTYP(3)=1) SDTYP(3)="" ;dispositions "RTN","DVBAB82",84,0) K:(SDTYP(3)=0) SDTYP(3) "RTN","DVBAB82",85,0) S:(SDTYP(5)=1) SDTYP(5)="" ;means test "RTN","DVBAB82",86,0) K:(SDTYP(5)=0) SDTYP(5) "RTN","DVBAB82",87,0) I SDTYP(7)=1 D ;team information "RTN","DVBAB82",88,0) . S SDTYP(7)="",GBL="^TMP(""SDPP"","_$J_")" "RTN","DVBAB82",89,0) K:(SDTYP(7)=0) SDTYP(7) "RTN","DVBAB82",90,0) D PRINT^SDPPRT "RTN","DVBAB82",91,0) S VALMBCK="R" "RTN","DVBAB82",92,0) Q "RTN","DVBAB82",93,0) ENDDT() ;Calculate end date for "all" date "RTN","DVBAB82",94,0) N DVBAPPTS,DVBX "RTN","DVBAB82",95,0) S DVBAPPTS(1)=2800101,DVBAPPTS(4)=DFN,DVBAPPTS("SORT")="P" "RTN","DVBAB82",96,0) S DVBAPPTS("FLDS")=1,DVBAPPTS("MAX")=-1 "RTN","DVBAB82",97,0) S DVBX=$S(($$SDAPI^SDAMA301(.DVBAPPTS)>0):$O(^TMP($J,"SDAMA301",DFN,0)),1:DT_.24) "RTN","DVBAB82",98,0) K ^TMP($J,"SDAMA301") "RTN","DVBAB82",99,0) Q DVBX "RTN","DVBAB82",100,0) ; "RTN","DVBAB82",101,0) VIEW ; Report # 9 - View Registration Data Report "RTN","DVBAB82",102,0) ; Parameters "RTN","DVBAB82",103,0) ; ========== "RTN","DVBAB82",104,0) ; DFN : Patient Identification Number "RTN","DVBAB82",105,0) ; "RTN","DVBAB82",106,0) U IO "RTN","DVBAB82",107,0) S DFN=$P(PARM,"^",1) "RTN","DVBAB82",108,0) D VAL Q:DVBERR "RTN","DVBAB82",109,0) D EN1^DGRP "RTN","DVBAB82",110,0) Q "RTN","DVBAB82",111,0) ; "RTN","DVBAB82",112,0) DSRP ; Report # 6 - Reprint a Notice of Discharge Report "RTN","DVBAB82",113,0) ; Parameters "RTN","DVBAB82",114,0) ; % : 1=Report on all veterans for a given day (BDATE required) "RTN","DVBAB82",115,0) ; : 0=Report on a single Veteran (DFN required) "RTN","DVBAB82",116,0) ; BDATE : Original Processing Date - $H/FileMan "RTN","DVBAB82",117,0) ; DFN : Patient Identification Number "RTN","DVBAB82",118,0) ; "RTN","DVBAB82",119,0) N %,BDATE,DFN,DFNIEN "RTN","DVBAB82",120,0) S %=$P(PARM,"^",1),BDATE=$P(PARM,"^",2),DFN=$P(PARM,"^",3),DFNIEN="" "RTN","DVBAB82",121,0) I BDATE="" S DVBERR=1,^TMP("DVBA",$J,1)="0^Incorrect Date" Q "RTN","DVBAB82",122,0) D DUZ2^DVBAUTIL "RTN","DVBAB82",123,0) U IO "RTN","DVBAB82",124,0) D VAL Q:DVBERR "RTN","DVBAB82",125,0) I %=1 D Q "RTN","DVBAB82",126,0) . S HD="SINGLE NOTICE OF DISCHARGE REPRINTING" "RTN","DVBAB82",127,0) . D NOPARM^DVBAUTL2 "RTN","DVBAB82",128,0) . I $D(DVBAQUIT) D KILL^DVBAUTIL Q ;CAUTION: Short-circuit "RTN","DVBAB82",129,0) . S DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ") "RTN","DVBAB82",130,0) . S HEAD="NOTICE OF DISCHARGE",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0) "RTN","DVBAB82",131,0) . I $D(^DVB(396.2,"B",DFN)) D "RTN","DVBAB82",132,0) . . S DFNIEN=$O(^DVB(396.2,"B",DFN,DFNIEN)),ADM=$P(^DVB(396.2,DFNIEN,0),U,3) "RTN","DVBAB82",133,0) . . I $D(^DGPM(+ADM,0)),$P(^(0),U,17)]"" S DCHPTR=$P(^DGPM(+ADM,0),U,17),DISCH=$S($P(^DGPM(DCHPTR,0),U,1)]"":$P(^(0),U,1),1:"") W ?($X+5),"Discharge date: ",$$FMTE^XLFDT(DISCH,"5DZ") "RTN","DVBAB82",134,0) . . I $P(^DVB(396.2,DFNIEN,0),U,7)'=DVBAD2 W *7,!!,"This does not belong to your RO.",!! H 3 Q "RTN","DVBAB82",135,0) . . I DFNIEN>0 S XDA=DFNIEN,DA=$P(^DVB(396.2,DFNIEN,0),U,1),ADMDT=$P(^DVB(396.2,DFNIEN,0),U,2),MB=$P(^(0),U,3) "RTN","DVBAB82",136,0) . . D REPRINT^DVBADSNT "RTN","DVBAB82",137,0) D DEQUE^DVBADSRP "RTN","DVBAB82",138,0) Q "RTN","DVBAB82",139,0) ; "RTN","DVBAB82",140,0) SPRPT ; Report # 8 - OP(Operation Report) "RTN","DVBAB82",141,0) ;Parameters "RTN","DVBAB82",142,0) ;============= "RTN","DVBAB82",143,0) ; DFN : Patient Identification Number "RTN","DVBAB82",144,0) ; SRTN : Select Operation "RTN","DVBAB82",145,0) ; "RTN","DVBAB82",146,0) N DFN,SRTN,MAGTMPR2,SRSITE "RTN","DVBAB82",147,0) I $O(^SRO(133,1))'="B" S SRSITE=1 "RTN","DVBAB82",148,0) S DFN=$P(PARM,"^",1),SRTN=$P(PARM,"^",2),MAGTMPR2=1 "RTN","DVBAB82",149,0) D VAL Q:DVBERR "RTN","DVBAB82",150,0) D ^SROPRPT "RTN","DVBAB82",151,0) Q "RTN","DVBAB82",152,0) ; "RTN","DVBAB82",153,0) CRPON ; Report # - 4 Reprint C&P Final Report "RTN","DVBAB82",154,0) ;Parameters "RTN","DVBAB82",155,0) ;============= "RTN","DVBAB82",156,0) ; RTYPE : Select Reprint Option (D)ate or (V)eteran "RTN","DVBAB82",157,0) ; RUNDATE : ORIGINAL PROCESSING date "RTN","DVBAB82",158,0) ; ANS : Reprinted by the RO or MAS "RTN","DVBAB82",159,0) ; % : LAB 1 OR 0 "RTN","DVBAB82",160,0) ; DA(1) : Patient IEN for lab results "RTN","DVBAB82",161,0) ; DFN : Patient Identification Number "RTN","DVBAB82",162,0) ; "RTN","DVBAB82",163,0) U IO "RTN","DVBAB82",164,0) N ONE "RTN","DVBAB82",165,0) S RTYPE=$P(PARM,"^",1),RUNDATE=$P(PARM,"^",2),ANS=$P(PARM,"^",3),%=$P(PARM,"^",4),DA(1)=$P(PARM,"^",5),DFN=$P(PARM,"^",6),DA=DA(1) "RTN","DVBAB82",166,0) I RTYPE="V" D VAL Q:DVBERR "RTN","DVBAB82",167,0) S XDD=^DD("DD"),$P(ULINE,"_",70)="_",ONE="N",Y=DT "RTN","DVBAB82",168,0) X XDD S HD="Reprint C & P Exams",SUPER=0 "RTN","DVBAB82",169,0) I $D(^XUSEC("DVBA C SUPERVISOR",DUZ)) S SUPER=1 "RTN","DVBAB82",170,0) S DVBCDT(0)=Y,PGHD="Compensation and Pension Exam Report",LOC=DUZ(2),PG=0,DVBCSITE=$S($D(^DVB(396.1,1,0)):$P(^(0),U,1),1:"Not specified") "RTN","DVBAB82",171,0) I "^D^V^"'[RTYPE S DVBERR=1,^TMP("DVBA",$J,1)="0^Incorrect Data Type" Q "RTN","DVBAB82",172,0) I ANS="R" K AUTO "RTN","DVBAB82",173,0) I ANS="M" S AUTO=1 "RTN","DVBAB82",174,0) I "^M^R^"'[ANS S DVBERR=1,^TMP("DVBA",$J,1)="0^Incorrect Data Type" Q "RTN","DVBAB82",175,0) I RTYPE="D" D GO^DVBCRPRT Q "RTN","DVBAB82",176,0) I RTYPE="V" D "RTN","DVBAB82",177,0) . S ONE="Y",RO=$P(^DVB(396.3,DA,0),U,3) "RTN","DVBAB82",178,0) . I RO'=DUZ(2)&('$D(AUTO))&(SUPER=0) W !!,*7,"Those results do not belong to your office.",!! Q "RTN","DVBAB82",179,0) . I RO=DUZ(2)&('$D(AUTO))&("RC"'[($P(^DVB(396.3,DA,0),U,18))) W *7,!!,"This request has not been released to the Regional Office yet.",!! Q "RTN","DVBAB82",180,0) . S PRTDATE=$P(^DVB(396.3,DA,0),U,16) I PRTDATE="" W *7,!!,"This has never been printed.",!! I SUPER=0 S OUT=1 Q "RTN","DVBAB82",181,0) . I %=1 D REN2^DVBCLABR Q "RTN","DVBAB82",182,0) . ;D OV^DVBCRPON "RTN","DVBAB82",183,0) . K DVBAON2 D SETLAB^DVBCPRNT,VARS^DVBCUTIL,STEP2^DVBCRPRT "RTN","DVBAB82",184,0) Q "RTN","DVBAB82",185,0) ; "RTN","DVBAB82",186,0) CIRPT ; Report # 5 - Insufficient Exam Report "RTN","DVBAB82",187,0) ;Parameters "RTN","DVBAB82",188,0) ;============= "RTN","DVBAB82",189,0) ; RPTTYPE : D/Detailed or S/Summary "RTN","DVBAB82",190,0) ; BEGDT : Beginning date $H/FileMan "RTN","DVBAB82",191,0) ; ENDDT : Ending date $H/FileMan "RTN","DVBAB82",192,0) ; RESANS : Insufficient Reason "RTN","DVBAB82",193,0) ; DVBAPRTY : Priority of Exam Code "RTN","DVBAB82",194,0) ; AO : Agent Orange "RTN","DVBAB82",195,0) ; BDD : Benefits Delivery at Discharge / Quick Start "RTN","DVBAB82",196,0) ; DES : DES Claimed Condition by Service Member / Fit for Duty "RTN","DVBAB82",197,0) ; ALL : All Others (Original Report w/ all codes except the above) "RTN","DVBAB82",198,0) ; "RTN","DVBAB82",199,0) N DVBAPRTY,RPTTYPE,BEGDT,ENDDT,RESANS "RTN","DVBAB82",200,0) U IO "RTN","DVBAB82",201,0) S RPTTYPE=$P(PARM,"^",1),BEGDT=$P(PARM,"^",2),ENDDT=$P(PARM,"^",3),RESANS=$P(PARM,"^",4) "RTN","DVBAB82",202,0) S DVBAPRTY=$P(PARM,"^",5) "RTN","DVBAB82",203,0) S ENDDT=ENDDT_".2359" "RTN","DVBAB82",204,0) I RPTTYPE="S" D SUM^DVBCIRPT Q "RTN","DVBAB82",205,0) I RPTTYPE="D" D "RTN","DVBAB82",206,0) . D INREAS "RTN","DVBAB82",207,0) . Q:($D(^TMP("DVBA",$J,1))) ;invalid reason sent "RTN","DVBAB82",208,0) . D EXMTPE,DETAIL^DVBCIRP1 "RTN","DVBAB82",209,0) Q "RTN","DVBAB82",210,0) ; "RTN","DVBAB82",211,0) EXMTPE ;exam types (retrieve all for filter) "RTN","DVBAB82",212,0) N DVBAXIFN "RTN","DVBAB82",213,0) F DVBAXIFN=0:0 S DVBAXIFN=$O(^DVB(396.6,DVBAXIFN)) Q:+DVBAXIFN=0 DO "RTN","DVBAB82",214,0) . S ^TMP($J,"XMTYPE",DVBAXIFN)="" "RTN","DVBAB82",215,0) Q "RTN","DVBAB82",216,0) INREAS ;insufficient reason (validate specific or retrieve all) "RTN","DVBAB82",217,0) N DVBAXIFN "RTN","DVBAB82",218,0) D:(RESANS="") ;use all insufficient reasons "RTN","DVBAB82",219,0) .F DVBAXIFN=0:0 S DVBAXIFN=$O(^DVB(396.94,DVBAXIFN)) Q:+DVBAXIFN=0 DO "RTN","DVBAB82",220,0) .. S DVBAARY("REASON",DVBAXIFN)="" "RTN","DVBAB82",221,0) D:(RESANS'="") ;use specific insufficient reason "RTN","DVBAB82",222,0) .I ('$D(^DVB(396.94,+RESANS))) D ;validate IEN "RTN","DVBAB82",223,0) ..S DVBERR=1,^TMP("DVBA",$J,1)="0^Invalid Insufficient Reason IEN" "RTN","DVBAB82",224,0) .E S DVBAARY("REASON",+RESANS)="" "RTN","DVBAB82",225,0) Q "RTN","DVBAB82",226,0) ; "RTN","DVBAB82",227,0) CRMS ; Report # 1 - Regional Office 21- day Certificate Printing Report. "RTN","DVBAB82",228,0) ; No Parameters "RTN","DVBAB82",229,0) ; "RTN","DVBAB82",230,0) U IO "RTN","DVBAB82",231,0) D ^DVBACRMS "RTN","DVBAB82",232,0) Q "RTN","DVBAB82",233,0) ; "RTN","DVBAB82",234,0) CRRR ; Report # 2 - Reprint a 21 - day Certificate for the RO "RTN","DVBAB82",235,0) ;Parameters "RTN","DVBAB82",236,0) ;============= "RTN","DVBAB82",237,0) ; DVBSEL : Select one of the following: "RTN","DVBAB82",238,0) ; N Patient Name "RTN","DVBAB82",239,0) ; D ORIGINAL PROCESSING DATE "RTN","DVBAB82",240,0) ; SDATE : ORIGINAL PROCESSING date - $H/FileMan "RTN","DVBAB82",241,0) ; XDA : Patient IEN "RTN","DVBAB82",242,0) ; "RTN","DVBAB82",243,0) U IO "RTN","DVBAB82",244,0) S DVBSEL=$P(PARM,"^",1),SDATE=$P(PARM,"^",2),XDA=$P(PARM,"^",3) "RTN","DVBAB82",245,0) I "^D^N^"'[DVBSEL S DVBERR=1,^TMP("DVBA",$J,1)="0^Incorrect Data Type" Q "RTN","DVBAB82",246,0) I DVBSEL="D" D I DVBERR Q "RTN","DVBAB82",247,0) . I SDATE="" S DVBERR=1,^TMP("DVBA",$J,1)="0^Undefined Date" Q "RTN","DVBAB82",248,0) . S %DT="X" S X=SDATE D ^%DT I Y<0 D Q "RTN","DVBAB82",249,0) . . S DVBERR=1,^TMP("DVBA",$J,1)="0^Incorrect Date Format" "RTN","DVBAB82",250,0) I DVBSEL="N" D I DVBERR Q "RTN","DVBAB82",251,0) . I XDA="" S DVBERR=1,^TMP("DVBA",$J,1)="0^Undefined Patient IEN" Q "RTN","DVBAB82",252,0) . S DIC=2,DIC(0)="NZX",X=XDA D ^DIC I Y<0 D I DVBERR Q "RTN","DVBAB82",253,0) . . S DVBERR=1,^TMP("DVBA",$J,1)="0^Invalid Patient Name." "RTN","DVBAB82",254,0) . S DFN=XDA "RTN","DVBAB82",255,0) D INIT^DVBACRRR I 'CONT Q "RTN","DVBAB82",256,0) D HDR^DVBACRRR,DATA^DVBACRRR "RTN","DVBAB82",257,0) Q "RTN","DVBAB82",258,0) ; "RTN","DVBAB82",259,0) CPRNT ; Report # 3 - Print C&P Final Report (manual) Report "RTN","DVBAB82",260,0) ; No Parameters "RTN","DVBAB82",261,0) ; "RTN","DVBAB82",262,0) S XDD=^DD("DD"),$P(ULINE,"_",70)="_",Y=DT "RTN","DVBAB82",263,0) X XDD S DVBCDT(0)=Y,PGHD="Compensation and Pension Exam Report",DVBCSITE=$S($D(^DVB(396.1,1,0)):$P(^(0),U,1),1:"Not Specified") "RTN","DVBAB82",264,0) D GO^DVBCPRNT "RTN","DVBAB82",265,0) Q "RTN","DVBAB82",266,0) VAL ; VALIDATE PATIENT "RTN","DVBAB82",267,0) I $G(DFN)="" S DVBERR=1,^TMP("DVBA",$J,1)="0^Undefined Patient IEN" G END "RTN","DVBAB82",268,0) S DIC=2,DIC(0)="NZX",X=DFN D ^DIC "RTN","DVBAB82",269,0) I Y<0 S DVBERR=1,^TMP("DVBA",$J,1)="0^Invalid Patient Name." G END "RTN","DVBAB82",270,0) Q "RTN","DVBAB82",271,0) ; "RTN","DVBAB82",272,0) VALDATE(DVBADTE) ;Validate Date "RTN","DVBAB82",273,0) ;dates must be valid internal FileMan format "RTN","DVBAB82",274,0) N X,Y,%DT "RTN","DVBAB82",275,0) S %DT="X",X=DVBADTE D ^%DT "RTN","DVBAB82",276,0) S:(Y=-1) DVBERR=1,^TMP("DVBA",$J,1)="0^Invalid FileMan formatted date." "RTN","DVBAB82",277,0) Q "RTN","DVBAB82",278,0) ; "RTN","DVBAB82",279,0) CNHDEOC ; Report #10 - FBCNH Display Episode of Care "RTN","DVBAB82",280,0) ; Parameters "RTN","DVBAB82",281,0) ; ========== "RTN","DVBAB82",282,0) ; DFN : IEN in PATIENT (#2) file "RTN","DVBAB82",283,0) ; IFN : IEN in FEE CNH ACTIVITY (#162.3) file "RTN","DVBAB82",284,0) ; "RTN","DVBAB82",285,0) U IO "RTN","DVBAB82",286,0) N DFN,IFN "RTN","DVBAB82",287,0) S DFN=$P(PARM,U,1),IFN=$P(PARM,U,2) "RTN","DVBAB82",288,0) D ^FBNHDEC ;DBIA#: 5566 "RTN","DVBAB82",289,0) Q "RTN","DVBAB82",290,0) ; "RTN","DVBAB82",291,0) CNHRP ; Report #11 - FBCNH Roster Print "RTN","DVBAB82",292,0) ; Parameters "RTN","DVBAB82",293,0) ; ========== "RTN","DVBAB82",294,0) ; DVBADLMTD : 0 (Standard) or 1 (Delimited) "RTN","DVBAB82",295,0) ; "RTN","DVBAB82",296,0) U IO "RTN","DVBAB82",297,0) S DVBADLMTD=+$P($G(PARM),U) "RTN","DVBAB82",298,0) D START^FBNHROS ;DBIA#: 5566 "RTN","DVBAB82",299,0) Q "RTN","DVBAB82",300,0) ; "RTN","DVBAB82",301,0) CNHRAD ; Report #12 - FBCNH Report of Admissions/Discharges "RTN","DVBAB82",302,0) ; Parameters "RTN","DVBAB82",303,0) ; ========== "RTN","DVBAB82",304,0) ; BEGDATE : Start date in FM format "RTN","DVBAB82",305,0) ; ENDDATE : End date in FM format "RTN","DVBAB82",306,0) ; DVBADLMTD : 0 (Standard) or 1 (Delimited) "RTN","DVBAB82",307,0) ; "RTN","DVBAB82",308,0) U IO "RTN","DVBAB82",309,0) N BEGDATE,ENDDATE "RTN","DVBAB82",310,0) S BEGDATE=$P(PARM,U,1),ENDDATE=$P(PARM,U,2) "RTN","DVBAB82",311,0) S DVBADLMTD=+$P(PARM,U,3) "RTN","DVBAB82",312,0) D VALDATE(BEGDATE),VALDATE(ENDDATE) "RTN","DVBAB82",313,0) D:('+DVBERR) START^FBNHAMIE ;DBIA#: 5566 "RTN","DVBAB82",314,0) Q "RTN","DVBAB82",315,0) ; "RTN","DVBAB82",316,0) CNHSE90D ; Report #13 - FBCNH Stays in Excess of 90 Days "RTN","DVBAB82",317,0) ; Parameters "RTN","DVBAB82",318,0) ; ========== "RTN","DVBAB82",319,0) ; FBDT : Effective date in FM format "RTN","DVBAB82",320,0) ; DVBADLMTD : 0 (Standard) or 1 (Delimited) "RTN","DVBAB82",321,0) ; "RTN","DVBAB82",322,0) U IO "RTN","DVBAB82",323,0) N FBDT "RTN","DVBAB82",324,0) S FBDT=$P(PARM,U,1),DVBADLMTD=+$P(PARM,U,2) "RTN","DVBAB82",325,0) D VALDATE(FBDT) "RTN","DVBAB82",326,0) D:('+DVBERR) START^FBNHAMI2 ;DBIA#: 5566 "RTN","DVBAB82",327,0) Q "RTN","DVBAB82",328,0) ; "RTN","DVBAB82",329,0) HFS() ; -- get hfs file name "RTN","DVBAB82",330,0) N H "RTN","DVBAB82",331,0) S H=$H "RTN","DVBAB82",332,0) Q "DVBA_"_$J_"_"_$P(H,",")_"_"_$P(H,",",2)_".DAT" "RTN","DVBAB82",333,0) ; "RTN","DVBAB82",334,0) HFSOPEN(HANDLE,DVBHFS,DVBMODE) ; Open File "RTN","DVBAB82",335,0) S DVBDIRY=$$GET^XPAR("DIV","DVB HFS SCRATCH") "RTN","DVBAB82",336,0) ;I DVBDIRY="" S ECERR=1 D Q "RTN","DVBAB82",337,0) ;. S ^TMP("DVBA",$J,1)="0^A scratch directory for reports doesn't exist" "RTN","DVBAB82",338,0) D OPEN^%ZISH(HANDLE,,DVBHFS,$G(DVBMODE,"W")) D:POP Q:POP "RTN","DVBAB82",339,0) .S DVBERR=1,^TMP("DVBA",$J,1)="0^Unable to open file " "RTN","DVBAB82",340,0) S IOF="$$IOF^DVBAB82" ;resets screen position and adds page break flag - added to deal with Linux environments. "RTN","DVBAB82",341,0) Q "RTN","DVBAB82",342,0) ; "RTN","DVBAB82",343,0) HFSCLOSE(HANDLE,DVBHFS) ;Close HFS and unload data "RTN","DVBAB82",344,0) N DVBDEL,X,%ZIS "RTN","DVBAB82",345,0) D CLOSE^%ZISH(HANDLE) "RTN","DVBAB82",346,0) S ROOT=$NA(^TMP("DVBA",$J,1)),DVBDEL(DVBHFS)="" "RTN","DVBAB82",347,0) K:('+DVBERR) @ROOT "RTN","DVBAB82",348,0) S X=$$FTG^%ZISH(,DVBHFS,$NA(@ROOT@(1)),4) "RTN","DVBAB82",349,0) S X=$$DEL^%ZISH(,$NA(DVBDEL)) "RTN","DVBAB82",350,0) Q "RTN","DVBAB82",351,0) ; "RTN","DVBAB82",352,0) IOF() ;used to reset position and insert page break flag when @IOF is executed. "RTN","DVBAB82",353,0) S $X=0,$Y=0 "RTN","DVBAB82",354,0) Q "##FFFF##"_$C(13,10) "RTN","DVBAB82",355,0) ; "RTN","DVBAB82",356,0) REQSTAT ; Report #14 - Request Status by Date Range "RTN","DVBAB82",357,0) ; Parameters "RTN","DVBAB82",358,0) ; ========== "RTN","DVBAB82",359,0) ; BEGDAT : Start date in FM format "RTN","DVBAB82",360,0) ; ENDDAT : End date in FM format "RTN","DVBAB82",361,0) ; REQSTAT : Request Status filter "RTN","DVBAB82",362,0) ; ISDELIM : 0 (Standard format); 1 (Delimited format) "RTN","DVBAB82",363,0) ; ISNODT : 0 (Use date range); 1 (Ignore date range) "RTN","DVBAB82",364,0) U IO "RTN","DVBAB82",365,0) N BEGDAT,ENDDAT,REQSTAT "RTN","DVBAB82",366,0) S BEGDAT=$P(PARM,U,1),ENDDAT=$P(PARM,U,2) "RTN","DVBAB82",367,0) S REQSTAT=$P(PARM,U,3),ISDELIM=$P(PARM,U,4),ISNODT=$P(PARM,U,5) "RTN","DVBAB82",368,0) D VALDATE(BEGDAT),VALDATE(ENDDAT) "RTN","DVBAB82",369,0) D:('+DVBERR) REQSTAT^DVBARSBD(BEGDAT,ENDDAT,REQSTAT,ISDELIM,ISNODT) "RTN","DVBAB82",370,0) Q "RTN","DVBAB82",371,0) ; "RTN","DVBAB82",372,0) DVBA8861 ; Report #15 - Form 28-8861 Status Report "RTN","DVBAB82",373,0) ; Parameters "RTN","DVBAB82",374,0) ; ========== "RTN","DVBAB82",375,0) ; BEGDAT - Start date in FM format "RTN","DVBAB82",376,0) ; ENDDAT - End date in FM format "RTN","DVBAB82",377,0) ; ROSTAT - Regional Office filter "RTN","DVBAB82",378,0) ; REQSTAT - Request Status filter "RTN","DVBAB82",379,0) ; DELIMTER - 0 (Standard format); 1 (Delimited format) "RTN","DVBAB82",380,0) ; "RTN","DVBAB82",381,0) U IO "RTN","DVBAB82",382,0) N BEGDAT,ENDDAT,REQSTAT "RTN","DVBAB82",383,0) S BEGDAT=$P(PARM,U,1),ENDDAT=$P(PARM,U,2) "RTN","DVBAB82",384,0) S ROSTAT=$P(PARM,U,3),REQSTAT=$P(PARM,U,4),DELIMTER=$P(PARM,U,5) "RTN","DVBAB82",385,0) D VALDATE(BEGDAT),VALDATE(ENDDAT) "RTN","DVBAB82",386,0) D:('+DVBERR) STATRPT^DVBA8861(BEGDAT,ENDDAT,ROSTAT,REQSTAT,DELIMTER) "RTN","DVBAB82",387,0) Q "RTN","DVBABFRM") 0^10^B55183576^B51513354 "RTN","DVBABFRM",1,0) DVBABFRM ;ALB/SPH - CAPRI TEMPLATE/WORKSHEETS UTILITIES ;11/17/02 "RTN","DVBABFRM",2,0) ;;2.7;AMIE;**53,57,90,123,181**;Apr 10, 1995;Build 38 "RTN","DVBABFRM",3,0) ; "RTN","DVBABFRM",4,0) DEFINE(Y,DVBIEN,DVBTYPE) ; "RTN","DVBABFRM",5,0) ; DVBTYPE: 1= Form Definition, 2=Script, 3=Report "RTN","DVBABFRM",6,0) N DVBJ K ^TMP($J,"AMIE") "RTN","DVBABFRM",7,0) S DVBJ=0,DVBTYPE=DVBTYPE+2,Y=$NA(^TMP($J,"AMIE")) "RTN","DVBABFRM",8,0) F S DVBJ=$O(^DVB(396.18,DVBIEN,DVBTYPE,DVBJ)) Q:'DVBJ D "RTN","DVBABFRM",9,0) .S ^TMP($J,"AMIE",DVBJ)=$G(^DVB(396.18,DVBIEN,DVBTYPE,DVBJ,0))_$C(13) "RTN","DVBABFRM",10,0) Q "RTN","DVBABFRM",11,0) UPDATE(Y,DVBIEN,DVBTYPE,DVBLINES,DVBLINEC,DVBLINEB) ; "RTN","DVBABFRM",12,0) ; DVBTYPE: 1= Form Definition, 2=Script, 3=Report "RTN","DVBABFRM",13,0) N DVBNUM,DVBCOUNT "RTN","DVBABFRM",14,0) I DVBTYPE=1,DVBLINEB=0 D "RTN","DVBABFRM",15,0) .K ^DVB(396.18,DVBIEN,3) "RTN","DVBABFRM",16,0) .S ^DVB(396.18,DVBIEN,3,0)=DVBLINES(1) "RTN","DVBABFRM",17,0) S DVBNUM=DVBLINEB,DVBCOUNT=1,DVBTYPE=DVBTYPE+2 "RTN","DVBABFRM",18,0) I DVBLINEB=0 S DVBCOUNT=2 "RTN","DVBABFRM",19,0) I DVBNUM>0 S DVBNUM=DVBNUM-1 "RTN","DVBABFRM",20,0) F S DVBNUM=DVBNUM+1 Q:DVBNUM=(DVBLINEC+DVBLINEB) D "RTN","DVBABFRM",21,0) .S ^DVB(396.18,DVBIEN,DVBTYPE,DVBNUM,0)=DVBLINES(DVBCOUNT),DVBCOUNT=DVBCOUNT+1 "RTN","DVBABFRM",22,0) Q "RTN","DVBABFRM",23,0) SAVE(Y,DVBIEN,DVBLINES,DVBLINEC,DVBLINEB,DVBTPSV) ; "RTN","DVBABFRM",24,0) ; DVBTPSV: 3/NULL=NORMAL GLOBAL "RTN","DVBABFRM",25,0) N DVBNUM,DVBCOUNT "RTN","DVBABFRM",26,0) S DVBTPSV=$G(DVBTPSV,3),DVBNUM=DVBLINEB,DVBCOUNT=1 "RTN","DVBABFRM",27,0) I DVBLINEB=0 D "RTN","DVBABFRM",28,0) .K ^DVB(396.17,DVBIEN,DVBTPSV) "RTN","DVBABFRM",29,0) .S ^DVB(396.17,DVBIEN,DVBTPSV,0)=DVBLINES(1),DVBCOUNT=2 "RTN","DVBABFRM",30,0) I DVBNUM>0 S DVBNUM=DVBNUM-1 "RTN","DVBABFRM",31,0) F S DVBNUM=DVBNUM+1 Q:DVBNUM=(DVBLINEC+DVBLINEB) D "RTN","DVBABFRM",32,0) .S ^DVB(396.17,DVBIEN,DVBTPSV,DVBNUM,0)=DVBLINES(DVBCOUNT),DVBCOUNT=DVBCOUNT+1 "RTN","DVBABFRM",33,0) ; SET Y TO NUMBER OF LINES IN THE GLOBAL FOR GUI VERIFICATION "RTN","DVBABFRM",34,0) S Y=+$P($G(^DVB(396.17,DVBIEN,DVBTPSV,0)),U,3) "RTN","DVBABFRM",35,0) Q "RTN","DVBABFRM",36,0) LOAD(Y,DVBIEN,DVBTPSV) ; "RTN","DVBABFRM",37,0) ; DVBTPSV: 3/NULL=NORMAL GLOBAL "RTN","DVBABFRM",38,0) N DVBABCNT,DVBABIEN K ^TMP("DVBAFRML",DUZ) "RTN","DVBABFRM",39,0) S DVBTPSV=$G(DVBTPSV,3),DVBABCNT=1,DVBABIEN=0,Y=$NA(^TMP("DVBAFRML",DUZ)) "RTN","DVBABFRM",40,0) F S DVBABIEN=$O(^DVB(396.17,DVBIEN,DVBTPSV,DVBABIEN)) Q:'DVBABIEN D "RTN","DVBABFRM",41,0) .S ^TMP("DVBAFRML",DUZ,DVBABCNT-1)=$G(^DVB(396.17,DVBIEN,DVBTPSV,DVBABCNT,0))_$C(13),DVBABCNT=DVBABCNT+1 "RTN","DVBABFRM",42,0) Q "RTN","DVBABFRM",43,0) CCOW(Y,F) ;RPC DVBAB CCOW "RTN","DVBABFRM",44,0) S Y=-1 "RTN","DVBABFRM",45,0) S:F=1 Y=$$SITE^VASITE "RTN","DVBABFRM",46,0) S:F=2 Y=$$PROD^XUPROD "RTN","DVBABFRM",47,0) Q "RTN","DVBABFRM",48,0) U1N4(Y,ARR) ;RPC DVBAB FETCH 1U4N "RTN","DVBABFRM",49,0) N I,X S I="",Y=$NA(^TMP("DVBU1N4",$J)) K @Y "RTN","DVBABFRM",50,0) F S I=$O(ARR(I)) Q:I="" D "RTN","DVBABFRM",51,0) .S X=$P($G(^DVB(396.17,ARR(I),0)),U) "RTN","DVBABFRM",52,0) .S:X X=$$GET1^DIQ(2,X_",",.0905) "RTN","DVBABFRM",53,0) .S ^TMP("DVBU1N4",$J,I)=ARR(I)_U_$S(X]"":X,1:"?????") "RTN","DVBABFRM",54,0) Q "RTN","DVBABFRM",55,0) DELETE(Y,IEN) ;RPC DVBAB FORM DATA BACKUP DELETE "RTN","DVBABFRM",56,0) S IEN=$G(IEN),Y=$S(IEN?1.N:0,1:"1^INVALID ARGUMENT") "RTN","DVBABFRM",57,0) I 'Y,'$D(^DVB(396.17,IEN,0)) S Y="1^RECORD NOT FOUND" "RTN","DVBABFRM",58,0) K:'Y&$D(^DVB(396.17,IEN,9)) ^DVB(396.17,IEN,9) "RTN","DVBABFRM",59,0) Q "RTN","DVBABFRM",60,0) BACKUP(Y,IEN,TXT) ;RPC DVBAB FORM DATA BACKUP "RTN","DVBABFRM",61,0) N F,S,A,N,M,R S F=396.17,M="-1^RECORD NOT FOUND",IEN=$G(IEN)_"," "RTN","DVBABFRM",62,0) S R="^DVB("_F_","_IEN,Y=$S(IEN?1.N1",":0,1:"-1^INVALID ARGUMENT") "RTN","DVBABFRM",63,0) I 'Y,'$D(@(R_"0)")) S Y=M "RTN","DVBABFRM",64,0) Q:Y S M=$P($G(@(R_"3,0)")),U,3) Q:'M "RTN","DVBABFRM",65,0) S S=396.19,N="+1,"_IEN,TXT=$G(TXT) "RTN","DVBABFRM",66,0) S A(S,N,.01)=$$NOW^XLFDT "RTN","DVBABFRM",67,0) S A(S,N,2)=$S(TXT]"":TXT,1:"Automatic Save by "_$P($G(^VA(200,DUZ,0)),U)) "RTN","DVBABFRM",68,0) D UPDATE^DIE(,"A"),ERR(.Y) "RTN","DVBABFRM",69,0) I 'Y D "RTN","DVBABFRM",70,0) .S N=$P($G(@(R_"9,0)")),U,3)_","_IEN "RTN","DVBABFRM",71,0) .D WP^DIE(S,N,1,"A",R_"3)"),ERR(.Y) "RTN","DVBABFRM",72,0) .D:'Y WP^DIE(S,N,3,"A",R_"1)"),ERR(.Y) "RTN","DVBABFRM",73,0) S:'Y Y=M "RTN","DVBABFRM",74,0) Q "RTN","DVBABFRM",75,0) RESTORE(Y,IEN,SN) ;RPC DVBAB FORM DATA BACKUP RESTORE "RTN","DVBABFRM",76,0) N Z,F,T,M,N,R "RTN","DVBABFRM",77,0) ; "RTN","DVBABFRM",78,0) S IEN=$G(IEN)_"," "RTN","DVBABFRM",79,0) S SN=$G(SN) "RTN","DVBABFRM",80,0) S N=396.17 "RTN","DVBABFRM",81,0) S R="^DVB("_N_","_IEN "RTN","DVBABFRM",82,0) S Y=$S(IEN?1.N1","&(SN?1.N):0,1:"-1^INVALID ARGUMENT") "RTN","DVBABFRM",83,0) S M="-1^RECORD NOT FOUND" "RTN","DVBABFRM",84,0) S SN=R_"9,"_SN_"," "RTN","DVBABFRM",85,0) S F="RESTORE " "RTN","DVBABFRM",86,0) ; "RTN","DVBABFRM",87,0) I 'Y,'$D(@(R_"0)")) S Y=M "RTN","DVBABFRM",88,0) I 'Y,'$D(@(R_"9,0)")) S $P(M,U,2)="SUB-"_$P(M,U,2),Y=M "RTN","DVBABFRM",89,0) I 'Y,'$D(@(SN_"0)")) S $P(M,U,2)=F_$P(M,U,2),Y=M "RTN","DVBABFRM",90,0) Q:Y S M=$P($G(@(SN_"1,0)")),U,3),F=F_"FAILED: " Q:'M "RTN","DVBABFRM",91,0) ; "RTN","DVBABFRM",92,0) M ^XTMP("DVBA",$J,"NODE3")=@(R_"3)") K @(R_"3)") "RTN","DVBABFRM",93,0) D WP^DIE(N,IEN,8,"A",SN_"1)"),ERR(.Y) "RTN","DVBABFRM",94,0) I Y K @(R_"3)") M @(R_"3)")=^XTMP("DVBA",$J,"NODE3") S $P(Y,U,2)=F_$P(Y,U,2) Q "RTN","DVBABFRM",95,0) ; "RTN","DVBABFRM",96,0) M ^XTMP("DVBA",$J,"NODE1")=@(R_"1)") K @(R_"1)") "RTN","DVBABFRM",97,0) D WP^DIE(N,IEN,6,"A",SN_"3)"),ERR(.Y) I 'Y S Y=M Q "RTN","DVBABFRM",98,0) K @(R_"3)"),@(R_"1)") "RTN","DVBABFRM",99,0) M @(R_"3)")=^XTMP("DVBA",$J,"NODE3"),@(R_"1)")=^XTMP("DVBA",$J,"NODE1") "RTN","DVBABFRM",100,0) S $P(Y,U,2)=F_$P(Y,U,2) "RTN","DVBABFRM",101,0) ; "RTN","DVBABFRM",102,0) ;cleanup ^xtmp global "RTN","DVBABFRM",103,0) K ^XTMP("DVBA",$J) "RTN","DVBABFRM",104,0) Q "RTN","DVBABFRM",105,0) COPY(Y,DA,DFN) ;RPC DVBAB FORM COPY "RTN","DVBABFRM",106,0) N F,A,P,N,M,R S DA=$G(DA)_",",F=396.17,R="^DVB("_F_","_DA "RTN","DVBABFRM",107,0) S N=" NOT FOUND",M="-1^RECORD"_N,DFN=$G(DFN,$P($G(@(R_"0)")),U)) "RTN","DVBABFRM",108,0) S Y=$S(DA?1.N1",":0,1:"-1^INVALID ARGUMENT") "RTN","DVBABFRM",109,0) I 'Y,'$D(@(R_"0)")) S Y=M "RTN","DVBABFRM",110,0) I 'Y,'$D(^DPT(DFN,0)) S Y="-1^PATIENT"_N "RTN","DVBABFRM",111,0) S:'Y Y=$$AF(R) Q:Y "RTN","DVBABFRM",112,0) S P="+1,",A(F,P,.01)=DFN,A(F,P,2)=DUZ,A(F,P,11)="D" "RTN","DVBABFRM",113,0) S N=$$NOW^XLFDT,A(F,P,3)=N,A(F,P,4)=N "RTN","DVBABFRM",114,0) S A(F,P,9)=$P($G(@(R_"4)")),U),A(F,P,5)=2800101 "RTN","DVBABFRM",115,0) D UPDATE^DIE(,"A"),ERR(.Y) "RTN","DVBABFRM",116,0) S DA=$P(@($P(R,",")_",0)"),U,3) "RTN","DVBABFRM",117,0) D:'Y WP^DIE(F,DA_",",6,"A",R_"1)"),ERR(.Y),DEL(Y,DA,F) "RTN","DVBABFRM",118,0) D:'Y WP^DIE(F,DA_",",8,"A",R_"3)"),ERR(.Y),DEL(Y,DA,F) "RTN","DVBABFRM",119,0) S:'Y Y=DA "RTN","DVBABFRM",120,0) Q "RTN","DVBABFRM",121,0) DEL(Y,DA,F,DIK) Q:'Y S DIK=$G(DIK,^DIC(F,0,"GL")) D ^DIK Q "RTN","DVBABFRM",122,0) AF(R) N C,I,J,K,L,N,X,Z S (I,C)=0,R=R_"1,",L="" "RTN","DVBABFRM",123,0) F S I=$O(@(R_I_")")) Q:'I D "RTN","DVBABFRM",124,0) .S K=$G(@(R_I_",0)")),N=$P(K,U,2),(Z,J)=0,K=+K "RTN","DVBABFRM",125,0) .S:K J=$G(^DVB(396.18,K,2)),X=$P(J,U,2),Z=DT<+J!(X'>DT&X) "RTN","DVBABFRM",126,0) .I Z!'K!'J S C=C+1 S:C>1 L=L_"; " S L=L_$S(N]"":N,1:$G(^DVB(396.18,K,0))) "RTN","DVBABFRM",127,0) Q:'C 0 "RTN","DVBABFRM",128,0) Q "-1^Can't copy because th"_$S(C=1:"is form is",1:"ese forms are")_"n't active: "_L "RTN","DVBABFRM",129,0) ERR(M) N D,I,K,X S M=0,D="DIERR" Q:'$D(^TMP(D,$J)) "RTN","DVBABFRM",130,0) S M=$O(^TMP(D,$J,"E","")),I=$O(^(M,"")),X="," "RTN","DVBABFRM",131,0) F K=0:1 S K=$O(^TMP(D,$J,I,"TEXT",K)) Q:'K S X=X_" "_^(K) "RTN","DVBABFRM",132,0) S M="-1^Error "_M_X K ^TMP(D,$J) "RTN","DVBABFRM",133,0) Q "RTN","DVBABFRM",134,0) RSTLIST(DVBABY,IEN) ;RPC DVBAB RESTRICTED LIST PATIENTS "RTN","DVBABFRM",135,0) ; RETURNS A LIST OF PATIENTS IN THE USER'S CLAIMS SYSTEM "RTN","DVBABFRM",136,0) ; RESTRICTED LIST IN THE FORMAT "RTN","DVBABFRM",137,0) ; LISTNAME (OR NULL)^PTIEN^PT NAME^EXP DATE^EXP DAT INTERNAL^SSN^DOB^ICN "RTN","DVBABFRM",138,0) ; $$GETICN^MPIF001 - supported ICR #2701 "RTN","DVBABFRM",139,0) ; "RTN","DVBABFRM",140,0) N DVB1,DVB2,DVB3,DVB4,DVB5,DVBABIEN,DVBABIE2,DVBABIE3,DVBABIE4 "RTN","DVBABFRM",141,0) N DVBABPT1 "RTN","DVBABFRM",142,0) N DVBABDTA,DVBABD1,DVBABD2,DVBABD3,DVBABD4,DVBABD5,DVBABD6 "RTN","DVBABFRM",143,0) N DVBABD7,DVBABD8 "RTN","DVBABFRM",144,0) N DVBABCNT "RTN","DVBABFRM",145,0) S DVBABCNT=0 "RTN","DVBABFRM",146,0) K ^TMP("DVBARLST",DUZ) "RTN","DVBABFRM",147,0) S DVBABIEN=0,DVBABPT1=0 "RTN","DVBABFRM",148,0) ; FIND MATCH TO USER IEN "RTN","DVBABFRM",149,0) F S DVBABIEN=$O(^DVB(396.956,DVBABIEN)) Q:'DVBABIEN I $P(^DVB(396.956,DVBABIEN,0),"^",1)=IEN S DVBABPT1=DVBABIEN "RTN","DVBABFRM",150,0) I DVBABPT1>0 D "RTN","DVBABFRM",151,0) .;FOUND A USER, NOW FIND PATIENTS ASSIGNED TO THE USER "RTN","DVBABFRM",152,0) .W "FOUND AT ",DVBABPT1,! "RTN","DVBABFRM",153,0) .S DVBABIE4=0 "RTN","DVBABFRM",154,0) .F S DVBABIE4=$O(^DVB(396.956,DVBABPT1,1,DVBABIE4)) Q:'DVBABIE4 D "RTN","DVBABFRM",155,0) ..S DVBABD1="" ;LISTNAME "RTN","DVBABFRM",156,0) ..S DVBABD2=$P(^DVB(396.956,DVBABPT1,1,DVBABIE4,0),"^",1) ;PT IEN "RTN","DVBABFRM",157,0) ..S DVBABD3=$P(^DPT(DVBABD2,0),"^",1) ; PT EXTERNAL NAME "RTN","DVBABFRM",158,0) ..S DVBABD5=$P(^DVB(396.956,DVBABPT1,1,DVBABIE4,0),"^",2) ;EXPIRATION DATE "RTN","DVBABFRM",159,0) ..S Y=DVBABD5 D DD^%DT S DVBABD4=Y ;EXPIRATION DATE EXTERNAL FORMAT "RTN","DVBABFRM",160,0) ..S DVBABD6=$P(^DPT(DVBABD2,0),"^",9) ; SSN "RTN","DVBABFRM",161,0) ..S DVBABD7=$P(^DPT(DVBABD2,0),U,3) ; DOB "RTN","DVBABFRM",162,0) ..S DVBABD8=$$GETICN^MPIF001(DVBABD2) ; ICN "RTN","DVBABFRM",163,0) ..S DVBABDTA=DVBABD1_"^"_DVBABD2_"^"_DVBABD3_"^"_DVBABD4_"^"_DVBABD5_"^"_DVBABD6_U_DVBABD7_U_DVBABD8 "RTN","DVBABFRM",164,0) ..W "DATA: ",DVBABDTA,! "RTN","DVBABFRM",165,0) ..S ^TMP("DVBARLST",DUZ,DVBABCNT)=DVBABDTA_$C(13),DVBABCNT=DVBABCNT+1 "RTN","DVBABFRM",166,0) .; "RTN","DVBABFRM",167,0) .;NEXT CHECK IF USER HAS ANY LISTS ASSIGNED "RTN","DVBABFRM",168,0) .;IF SO, ADD THE PATIENTS FROM THOSE LISTS TO THE OUTPUT "RTN","DVBABFRM",169,0) .; "RTN","DVBABFRM",170,0) .S DVBABIE4=0 "RTN","DVBABFRM",171,0) .F S DVBABIE4=$O(^DVB(396.956,DVBABPT1,2,DVBABIE4)) Q:'DVBABIE4 D "RTN","DVBABFRM",172,0) ..S DVBABIE3=$P(^DVB(396.956,DVBABPT1,2,DVBABIE4,0),"^",1) ;LIST IEN "RTN","DVBABFRM",173,0) ..W "LIST: ",DVBABIE3,! "RTN","DVBABFRM",174,0) ..; "RTN","DVBABFRM",175,0) ..;USER HAS A LIST. FIND IT AND ADD THOSE PATIENTS "RTN","DVBABFRM",176,0) ..; "RTN","DVBABFRM",177,0) ..S DVBABIE2=0 "RTN","DVBABFRM",178,0) ..F S DVBABIE2=$O(^DVB(396.965,DVBABIE3,1,DVBABIE2)) Q:'DVBABIE2 D "RTN","DVBABFRM",179,0) ...S DVBABD1=$P(^DVB(396.965,DVBABIE3,0),"^",1) ;LOSTNAME "RTN","DVBABFRM",180,0) ...S DVBABD2=$P(^DVB(396.965,DVBABIE3,1,DVBABIE2,0),"^",1) ;PT IEN "RTN","DVBABFRM",181,0) ...S DVBABD3=$P(^DPT(DVBABD2,0),"^",1) ; PT EXTERNAL NAME "RTN","DVBABFRM",182,0) ...S DVBABD5=$P(^DVB(396.965,DVBABIE3,1,DVBABIE2,0),"^",2) ;EXPIRATION DATE "RTN","DVBABFRM",183,0) ...S Y=DVBABD5 D DD^%DT S DVBABD4=Y ;EXPIRATION DATE EXTERNAL FORMAT "RTN","DVBABFRM",184,0) ...S DVBABD6=$P(^DPT(DVBABD2,0),"^",9) ; SSN "RTN","DVBABFRM",185,0) ...S DVBABD7=$P(^DPT(DVBABD2,0),U,3) ; DOB "RTN","DVBABFRM",186,0) ...S DVBABD8=$$GETICN^MPIF001(DVBABD2) ; ICN "RTN","DVBABFRM",187,0) ...S DVBABDTA=DVBABD1_"^"_DVBABD2_"^"_DVBABD3_"^"_DVBABD4_"^"_DVBABD5_"^"_DVBABD6_U_DVBABD7_U_DVBABD8 "RTN","DVBABFRM",188,0) ...W "DATA: ",DVBABDTA,! "RTN","DVBABFRM",189,0) ...S ^TMP("DVBARLST",DUZ,DVBABCNT)=DVBABDTA_$C(13),DVBABCNT=DVBABCNT+1 "RTN","DVBABFRM",190,0) S DVBABY=$NA(^TMP("DVBARLST",DUZ)) "RTN","DVBABFRM",191,0) K DVB1,DVB2,DVB3,DVB4,DVB5,DVBABIEN,DVBABPT1,DVBABIE2,DVBABIE3,DVBABIE4 "RTN","DVBABFRM",192,0) K DVBABDTA,DVBABD1,DVBABD2,DVBABD3,DVBABD4,DVBABD5,DVBABD6 "RTN","DVBABFRM",193,0) Q "RTN","DVBABURL") 0^1^B6313636^B2300547 "RTN","DVBABURL",1,0) DVBABURL ;ALB/SPH - CAPRI URL ;14/MAY/2012 "RTN","DVBABURL",2,0) ;;2.7;AMIE;**104,136,143,149,168,181**;Apr 10, 1995;Build 38 "RTN","DVBABURL",3,0) ; "RTN","DVBABURL",4,0) URL(Y,WHICH) ; "RTN","DVBABURL",5,0) ;This procedure supports the DVBAB GET URL remote procedure "RTN","DVBABURL",6,0) S Y="" "RTN","DVBABURL",7,0) ; 1=VBA's AMIE Worksheet Website "RTN","DVBABURL",8,0) ; 2=CAPRI training website "RTN","DVBABURL",9,0) ; 3=VistAWeb website "RTN","DVBABURL",10,0) ; 5=HIA download website "RTN","DVBABURL",11,0) ; 6=VIRTUAL VA web service server "RTN","DVBABURL",12,0) ; 999=Debug/Test Code "RTN","DVBABURL",13,0) I WHICH=1 S Y="http://152.124.238.193/bl/21/rating/Medical/exams/index.htm" "RTN","DVBABURL",14,0) I WHICH=2 S Y="http://vaww.demo.va.gov/" "RTN","DVBABURL",15,0) I WHICH=3 D "RTN","DVBABURL",16,0) . I '$$PROD^XUPROD S Y="-1^VistAWeb disabled for non-production systems." Q "RTN","DVBABURL",17,0) . S Y="https://vistaweb.med.va.gov/CapriPage.aspx" "RTN","DVBABURL",18,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",19,0) I WHICH=5 S Y=$$GET^XPAR("PKG","DVBAB CAPRI HIA UPDATE URL",1,"Q") "RTN","DVBABURL",20,0) I WHICH=6 D ;Virtual VA web service server "RTN","DVBABURL",21,0) . I $$PROD^XUPROD D "RTN","DVBABURL",22,0) . . S Y=$$GET^XPAR("PKG","DVBAB CAPRI VIRTUALVA PROD URL",1,"Q") "RTN","DVBABURL",23,0) . E D "RTN","DVBABURL",24,0) . . S Y=$$GET^XPAR("PKG","DVBAB CAPRI VIRTUALVA TEST URL",1,"Q") "RTN","DVBABURL",25,0) I WHICH=999 S Y="http://vhaannweb2.v11.med.va.gov/VwDesktop/CapriPage.aspx" "RTN","DVBABURL",26,0) Q "RTN","DVBABURL",27,0) ; "RTN","DVBABURL",28,0) VVATOKEN(DVBAUTH) ;retrieve and return the Virtual VA authorization credentials "RTN","DVBABURL",29,0) ;This procedure supports the DVBA GET VVA TOKEN remote procedure and "RTN","DVBABURL",30,0) ;retrieves the user, password, and token value required to login to the Virtual "RTN","DVBABURL",31,0) ;VA web service. The procedure supports returning differerent values based on "RTN","DVBABURL",32,0) ;whether the system is a production system or a test/development system. "RTN","DVBABURL",33,0) ; "RTN","DVBABURL",34,0) ; Returns user^password^token on success; otherwise returns "" "RTN","DVBABURL",35,0) ; Example: "capri^XXXXX^Username-1" "RTN","DVBABURL",36,0) ; "RTN","DVBABURL",37,0) N DVBUSER "RTN","DVBABURL",38,0) N DVBPWD "RTN","DVBABURL",39,0) N DVBTOKEN "RTN","DVBABURL",40,0) ; "RTN","DVBABURL",41,0) I $$PROD^XUPROD D ;return values for production system "RTN","DVBABURL",42,0) . S DVBUSER=$$GET^XPAR("PKG","DVBAB CAPRI VVA USER",1,"Q") "RTN","DVBABURL",43,0) . S DVBPWD=$$GET^XPAR("PKG","DVBAB CAPRI VVA PROD PASSWD",1,"Q") "RTN","DVBABURL",44,0) . S DVBTOKEN=$$GET^XPAR("PKG","DVBAB CAPRI VVA PROD TOKEN",1,"Q") "RTN","DVBABURL",45,0) E D ;return values for test/development system "RTN","DVBABURL",46,0) . S DVBUSER=$$GET^XPAR("PKG","DVBAB CAPRI VVA USER",1,"Q") "RTN","DVBABURL",47,0) . S DVBPWD=$$GET^XPAR("PKG","DVBAB CAPRI VVA TEST PASSWD",1,"Q") "RTN","DVBABURL",48,0) . S DVBTOKEN=$$GET^XPAR("PKG","DVBAB CAPRI VVA TEST TOKEN",1,"Q") "RTN","DVBABURL",49,0) I DVBUSER'="",DVBPWD'="",DVBTOKEN'="" D ;success "RTN","DVBABURL",50,0) . S DVBAUTH=DVBUSER_U_DVBPWD_U_DVBTOKEN "RTN","DVBABURL",51,0) E D ;failure "RTN","DVBABURL",52,0) . S DVBAUTH="" "RTN","DVBABURL",53,0) Q "RTN","DVBAHWSC") 0^9^B4863059^n/a "RTN","DVBAHWSC",1,0) DVBAHWSC ;ALB/RPM - CAPRI HEALTHEVET WEB SERVICES CLIENT TOOLS ;06/28/12 "RTN","DVBAHWSC",2,0) ;;2.7;AMIE;**181**;Apr 10, 1995;Build 38 "RTN","DVBAHWSC",3,0) ; "RTN","DVBAHWSC",4,0) Q ;no direct entry "RTN","DVBAHWSC",5,0) ; "RTN","DVBAHWSC",6,0) EN ; -- setup "RTN","DVBAHWSC",7,0) ; "RTN","DVBAHWSC",8,0) ; -- create DVBPSIM proxy "RTN","DVBAHWSC",9,0) D SETUP("PSIMWSEXECUTE.WSDL","DVB_PSIM_EXECUTE") "RTN","DVBAHWSC",10,0) Q "RTN","DVBAHWSC",11,0) ; "RTN","DVBAHWSC",12,0) CKSETUP(DVBWSDL) ; - used to check the environment "RTN","DVBAHWSC",13,0) ; returns the path to be used that was verified or 0 if it fails "RTN","DVBAHWSC",14,0) ; "RTN","DVBAHWSC",15,0) ; $$DEFDIR^%ZISH,$$LIST^%ZISH - #2320 "RTN","DVBAHWSC",16,0) ; BMES^XPDUTL - #10141 "RTN","DVBAHWSC",17,0) ; "RTN","DVBAHWSC",18,0) N DVBSTAT,DVBPATH,DVBFILE "RTN","DVBAHWSC",19,0) S DVBPATH=$$DEFDIR^%ZISH() "RTN","DVBAHWSC",20,0) S DVBFILE(DVBWSDL)="" "RTN","DVBAHWSC",21,0) S DVBSTAT=$$LIST^%ZISH(DVBPATH,"DVBFILE","DVBSTAT") "RTN","DVBAHWSC",22,0) I 'DVBSTAT!($D(DVBSTAT)'=11) D Q 0 "RTN","DVBAHWSC",23,0) . D BMES^XPDUTL("**** Error cannot find file "_DVBPATH_DVBWSDL) "RTN","DVBAHWSC",24,0) I 'DVBSTAT!($D(DVBSTAT)'=11) D Q 0 "RTN","DVBAHWSC",25,0) . W !!,"**** WSDL file "_DVBWSDL_" not found in "_DVBPATH_"." "RTN","DVBAHWSC",26,0) . W !," You will need that prior to install." "RTN","DVBAHWSC",27,0) Q DVBPATH "RTN","DVBAHWSC",28,0) ; "RTN","DVBAHWSC",29,0) SETUP(DVBWSDL,DVBSERV) ; -- call to setup hwsc "RTN","DVBAHWSC",30,0) ;DVBWSDL - call with the wsdl file to setup, must be in the "RTN","DVBAHWSC",31,0) ; kernel default directory "RTN","DVBAHWSC",32,0) ; "RTN","DVBAHWSC",33,0) ; $$GENPORT^XOBWLIB - #5421 "RTN","DVBAHWSC",34,0) ; "RTN","DVBAHWSC",35,0) N DVBSTAT,DVBPATH,DVBARR "RTN","DVBAHWSC",36,0) S DVBPATH=$$CKSETUP(DVBWSDL) I DVBPATH=0 Q "RTN","DVBAHWSC",37,0) S DVBFILE(DVBWSDL)="" "RTN","DVBAHWSC",38,0) S DVBARR("WSDL FILE")=DVBPATH_DVBWSDL "RTN","DVBAHWSC",39,0) S DVBARR("CACHE PACKAGE NAME")="DVBPSIM" "RTN","DVBAHWSC",40,0) S DVBARR("WEB SERVICE NAME")=DVBSERV "RTN","DVBAHWSC",41,0) S DVBARR("AVAILABILITY RESOURCE")="?wsdl" "RTN","DVBAHWSC",42,0) S DVBSTAT=$$GENPORT^XOBWLIB(.DVBARR) "RTN","DVBAHWSC",43,0) ; "RTN","DVBAHWSC",44,0) I 'DVBSTAT D BMES^XPDUTL("**** Error creating Web Service (#18.02)"_DVBSERV),MES^XPDUTL(DVBSTAT) Q "RTN","DVBAHWSC",45,0) D BMES^XPDUTL(">>> "_DVBSERV_" entry added to WEB SERVICE file #18.02") "RTN","DVBAHWSC",46,0) D BMES^XPDUTL(" - Be sure and set up the Web Server as in the post-install instructions!!") "RTN","DVBAHWSC",47,0) ; "RTN","DVBAHWSC",48,0) Q "RTN","DVBAHWSC",49,0) ; "RTN","DVBAHWSC",50,0) ERROR ; - catch errors "RTN","DVBAHWSC",51,0) ; Set ecode to empty to return to calling function "RTN","DVBAHWSC",52,0) ; "RTN","DVBAHWSC",53,0) ; $$EOFAC^XOBWLIB, ZTER^XOBWLIB - #5421 "RTN","DVBAHWSC",54,0) ; UNWIND^%ZTER - #1621 "RTN","DVBAHWSC",55,0) ; "RTN","DVBAHWSC",56,0) N DVBERR "RTN","DVBAHWSC",57,0) S DVBERR=$$EOFAC^XOBWLIB() "RTN","DVBAHWSC",58,0) D ZTER^XOBWLIB(DVBERR) "RTN","DVBAHWSC",59,0) S $ECODE="" "RTN","DVBAHWSC",60,0) D UNWIND^%ZTER "RTN","DVBAHWSC",61,0) Q "RTN","DVBAHWSC",62,0) ; "RTN","DVBAMVI1") 0^7^B86814663^n/a "RTN","DVBAMVI1",1,0) DVBAMVI1 ;ALB/RPM - CAPRI MVI SEARCH 1305/1306 PROCESSING ;6/27/2012 "RTN","DVBAMVI1",2,0) ;;2.7;AMIE;**181**;Apr 10, 1995;Build 38 "RTN","DVBAMVI1",3,0) ; "RTN","DVBAMVI1",4,0) Q ;NO DIRECT ENTRY "RTN","DVBAMVI1",5,0) ; "RTN","DVBAMVI1",6,0) FNDPAT(DVBRSLT,DVBDEM,DVBQUANT,DVBFRMT) ; "RTN","DVBAMVI1",7,0) ;This procedure supports the DVBA MVI SEARCH PERSON remote procedure. "RTN","DVBAMVI1",8,0) ; "RTN","DVBAMVI1",9,0) ; Input: "RTN","DVBAMVI1",10,0) ; DVBRSLT - RPC results parameter defined as an ARRAY "RTN","DVBAMVI1",11,0) ; DVBDEM - Patient demographics used for search delimited using "^" "RTN","DVBAMVI1",12,0) ; FIRSTNAME - piece 1 (required) "RTN","DVBAMVI1",13,0) ; MIDDLENAME or INITIAL - piece 2 (optional) "RTN","DVBAMVI1",14,0) ; LASTNAME - piece 3 (required) "RTN","DVBAMVI1",15,0) ; SSN (9 digits) - piece 4 (required) "RTN","DVBAMVI1",16,0) ; DATE OF BIRTH (FileMan format) - piece 5 (optional) "RTN","DVBAMVI1",17,0) ; "RTN","DVBAMVI1",18,0) ; ex. CAPRI^TEST^PATIENT^999999999^2540101 "RTN","DVBAMVI1",19,0) ; DVBQUANT - optional initialQuantity value passed to web service. "RTN","DVBAMVI1",20,0) ; Defaults to 10. "RTN","DVBAMVI1",21,0) ; DVBFRMT - optional name format type. "RTN","DVBAMVI1",22,0) ; 0 (Default) - Return name in First Middle Last Suffix format "RTN","DVBAMVI1",23,0) ; 1 - Return name in Last,First Middle Suffix format "RTN","DVBAMVI1",24,0) ; "RTN","DVBAMVI1",25,0) ; Output: "RTN","DVBAMVI1",26,0) ; DVBRSLT - array of matching patient records in caret-delimited "RTN","DVBAMVI1",27,0) ; format. "RTN","DVBAMVI1",28,0) ; "RTN","DVBAMVI1",29,0) ; FULLNAME - piece 1 "RTN","DVBAMVI1",30,0) ; SSN (9 digits) - piece 2 "RTN","DVBAMVI1",31,0) ; DATE OF BIRTH (external format) - piece 3 "RTN","DVBAMVI1",32,0) ; MVI ID - pieces 4-7 "RTN","DVBAMVI1",33,0) ; ID "RTN","DVBAMVI1",34,0) ; IdType "RTN","DVBAMVI1",35,0) ; Assigning Location "RTN","DVBAMVI1",36,0) ; Assigning Issuer "RTN","DVBAMVI1",37,0) ; "RTN","DVBAMVI1",38,0) ; Example results: "RTN","DVBAMVI1",39,0) ; CAPRI TEST PATIENT^999999999^1/1/1980^1062212234V192931^NI^200M^USVHA "RTN","DVBAMVI1",40,0) ; or "RTN","DVBAMVI1",41,0) ; PATIENT,CAPRI TEST^999999999^1/1/1980^1062212234V192931^NI^200M^USVHA "RTN","DVBAMVI1",42,0) ; "RTN","DVBAMVI1",43,0) N DVBXML ;1305 HL7v3 XML "RTN","DVBAMVI1",44,0) N DVBXMLR ;1306 HL7v3 XML "RTN","DVBAMVI1",45,0) N DVBCNT ;number of results "RTN","DVBAMVI1",46,0) N DVBPRS ;parsed results "RTN","DVBAMVI1",47,0) S DVBCNT=0 "RTN","DVBAMVI1",48,0) ; "RTN","DVBAMVI1",49,0) ;create the 1305 request message "RTN","DVBAMVI1",50,0) I (+$G(DVBQUANT)<1)!(+$G(DVBQUANT)>10) S DVBQUANT=10 "RTN","DVBAMVI1",51,0) I +$G(DVBFRMT)'=1 S DVBFRMT=0 "RTN","DVBAMVI1",52,0) S DVBXML=$$CRE81305(DVBDEM,DVBQUANT) "RTN","DVBAMVI1",53,0) ; "RTN","DVBAMVI1",54,0) ;transmit the message to the MVI "RTN","DVBAMVI1",55,0) D XMIT(DVBXML,.DVBXMLR) "RTN","DVBAMVI1",56,0) ; "RTN","DVBAMVI1",57,0) ;parse the returned 1306 request message "RTN","DVBAMVI1",58,0) I $D(DVBXMLR) D "RTN","DVBAMVI1",59,0) . D PARSE(.DVBXMLR,.DVBPRS) "RTN","DVBAMVI1",60,0) . ; "RTN","DVBAMVI1",61,0) . ;format the output array "RTN","DVBAMVI1",62,0) . D OUTPUT(.DVBPRS,.DVBRSLT) "RTN","DVBAMVI1",63,0) E D "RTN","DVBAMVI1",64,0) . S DVBRSLT(0)=0_U_"Communication error occurred" "RTN","DVBAMVI1",65,0) Q "RTN","DVBAMVI1",66,0) ; "RTN","DVBAMVI1",67,0) CRE81305(DVBDEM,DVBQUANT) ; create 1305 request xml document "RTN","DVBAMVI1",68,0) ; This function creates the HL7v3 1305 Search Person Request "RTN","DVBAMVI1",69,0) ; (Match criteria with person trait data) xml document "RTN","DVBAMVI1",70,0) ; "RTN","DVBAMVI1",71,0) ; DVBDEM = Patient demographics delimited using "^" "RTN","DVBAMVI1",72,0) ; DVBFNAME: FIRSTNAME - piece 1 "RTN","DVBAMVI1",73,0) ; DVBMNAME: MIDDLENAME - piece 2 "RTN","DVBAMVI1",74,0) ; DVBLNAME: LASTNAME - piece 3 "RTN","DVBAMVI1",75,0) ; DVBSSN: SSN - piece 4 "RTN","DVBAMVI1",76,0) ; DVBDOB: DATE OF BIRTH - piece 5 "RTN","DVBAMVI1",77,0) ; ex. CAPRI^TEST^PATIENT^999999999^2540101 "RTN","DVBAMVI1",78,0) ; "RTN","DVBAMVI1",79,0) ; DVBQUANT = initialQuantity value parameter "RTN","DVBAMVI1",80,0) ; "RTN","DVBAMVI1",81,0) ; Returns formatted XML for the search "RTN","DVBAMVI1",82,0) ; "RTN","DVBAMVI1",83,0) ; $$PARAM^HLCS2 - #3552 (need) "RTN","DVBAMVI1",84,0) ; "RTN","DVBAMVI1",85,0) N DVBFNAME ;first name "RTN","DVBAMVI1",86,0) N DVBLNAME ;last name "RTN","DVBAMVI1",87,0) N DVBMNAME ;middle name or initial "RTN","DVBAMVI1",88,0) N DVBSSN ;social security # "RTN","DVBAMVI1",89,0) N DVBDOB ;date of birth "RTN","DVBAMVI1",90,0) N DVBSKEY ;site key "RTN","DVBAMVI1",91,0) N DVBPCODE ;HL7 processing code "RTN","DVBAMVI1",92,0) N MPIXML ;function result "RTN","DVBAMVI1",93,0) ; "RTN","DVBAMVI1",94,0) S DVBPCODE=$P($$PARAM^HLCS2,"^",3) "RTN","DVBAMVI1",95,0) S DVBSKEY="200CAPR" "RTN","DVBAMVI1",96,0) S DVBFNAME=$P(DVBDEM,U,1) "RTN","DVBAMVI1",97,0) S DVBMNAME=$P(DVBDEM,U,2) "RTN","DVBAMVI1",98,0) S DVBLNAME=$P(DVBDEM,U,3) "RTN","DVBAMVI1",99,0) S DVBSSN=$P(DVBDEM,U,4) "RTN","DVBAMVI1",100,0) S DVBDOB=$P(DVBDEM,U,5) "RTN","DVBAMVI1",101,0) ; "RTN","DVBAMVI1",102,0) ;Header "RTN","DVBAMVI1",103,0) S MPIXML="" "RTN","DVBAMVI1",109,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",111,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",112,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",114,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",115,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",116,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",117,0) ; "RTN","DVBAMVI1",118,0) ; start "RTN","DVBAMVI1",119,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",120,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",121,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",122,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",123,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",124,0) ; "RTN","DVBAMVI1",125,0) ; start "RTN","DVBAMVI1",126,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",127,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",128,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",129,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",130,0) ; "RTN","DVBAMVI1",131,0) ; start "RTN","DVBAMVI1",132,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",134,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",136,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",138,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",139,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",140,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",141,0) I DVBDOB'="" D "RTN","DVBAMVI1",142,0) . S MPIXML=MPIXML_"" "RTN","DVBAMVI1",143,0) . S MPIXML=MPIXML_"" "RTN","DVBAMVI1",144,0) . S MPIXML=MPIXML_"LivingSubject..birthTime" "RTN","DVBAMVI1",145,0) . S MPIXML=MPIXML_"" "RTN","DVBAMVI1",146,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",147,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",148,0) S MPIXML=MPIXML_"SSN" "RTN","DVBAMVI1",149,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",150,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",151,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",152,0) S MPIXML=MPIXML_""""_DVBFNAME_"""" "RTN","DVBAMVI1",153,0) I $G(DVBMNAME)'="" D ;optional middle name or initial "RTN","DVBAMVI1",154,0) . S MPIXML=MPIXML_""""_DVBMNAME_"""" "RTN","DVBAMVI1",155,0) S MPIXML=MPIXML_""""_DVBLNAME_"""" "RTN","DVBAMVI1",156,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",157,0) S MPIXML=MPIXML_"Legal Name" "RTN","DVBAMVI1",158,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",159,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",160,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",161,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI1",162,0) Q MPIXML "RTN","DVBAMVI1",163,0) ; "RTN","DVBAMVI1",164,0) XMIT(DVBXML,DVBXMLR) ; "RTN","DVBAMVI1",165,0) ;This procedure transmits the formatted 1305 HL7v3 XML document "RTN","DVBAMVI1",166,0) ;and returns the 1306 HL7v3 XML results document. "RTN","DVBAMVI1",167,0) ; "RTN","DVBAMVI1",168,0) ; $$GETPROXY^XOBWLIB - #5421 "RTN","DVBAMVI1",169,0) ; "RTN","DVBAMVI1",170,0) N $ETRAP,$ESTACK,SVC "RTN","DVBAMVI1",171,0) ; "RTN","DVBAMVI1",172,0) ; set error trap "RTN","DVBAMVI1",173,0) S $ETRAP="DO ERROR^DVBAHWSC" "RTN","DVBAMVI1",174,0) ; "RTN","DVBAMVI1",175,0) ; make the call "RTN","DVBAMVI1",176,0) ; $$GETPROXY(web_service_name (#18.02), web_server_name (#18.12)) "RTN","DVBAMVI1",177,0) S SVC=$$GETPROXY^XOBWLIB("DVB_PSIM_EXECUTE","DVB_MVI_SERVER") "RTN","DVBAMVI1",178,0) S DVBXMLR=SVC.execute(DVBXML) "RTN","DVBAMVI1",179,0) ; "RTN","DVBAMVI1",180,0) Q "RTN","DVBAMVI1",181,0) ; "RTN","DVBAMVI1",182,0) PARSE(DVBXML,DVBOUT) ; "RTN","DVBAMVI1",183,0) ;This procedure parses the resulting 1306 HL7v3 XML document and "RTN","DVBAMVI1",184,0) ;builds an output array subscripted by record count and field item. "RTN","DVBAMVI1",185,0) ; "RTN","DVBAMVI1",186,0) ; EN^MXMLPRSE - #4149 "RTN","DVBAMVI1",187,0) ; "RTN","DVBAMVI1",188,0) K ^TMP($J,"DVBAMVI1") "RTN","DVBAMVI1",189,0) N DVBCB ;parser callback array "RTN","DVBAMVI1",190,0) N DVBVAR ;character values "RTN","DVBAMVI1",191,0) S DVBVAR="" "RTN","DVBAMVI1",192,0) S DVBCB("STARTELEMENT")="SE^DVBAMVI1" "RTN","DVBAMVI1",193,0) S DVBCB("ENDELEMENT")="EE^DVBAMVI1" "RTN","DVBAMVI1",194,0) S DVBCB("CHARACTERS")="VALUE^DVBAMVI1" "RTN","DVBAMVI1",195,0) S ^TMP($J,"DVBAMVI1",1)=DVBXML "RTN","DVBAMVI1",196,0) D EN^MXMLPRSE($NA(^TMP($J,"DVBAMVI1")),.DVBCB) "RTN","DVBAMVI1",197,0) K ^TMP($J,"DVBAMVI1") "RTN","DVBAMVI1",198,0) Q "RTN","DVBAMVI1",199,0) ; "RTN","DVBAMVI1",200,0) SE(DVBNM,DVBATTR) ; - used for the parser to call back with STARTELEMENT "RTN","DVBAMVI1",201,0) ; "RTN","DVBAMVI1",202,0) ; prevent any undefined errors "RTN","DVBAMVI1",203,0) S DVBNM=$G(DVBNM) "RTN","DVBAMVI1",204,0) S DVBATTR("extension")=$G(DVBATTR("extension")) "RTN","DVBAMVI1",205,0) S DVBATTR("code")=$G(DVBATTR("code")) "RTN","DVBAMVI1",206,0) ; "RTN","DVBAMVI1",207,0) ; set patient counter "RTN","DVBAMVI1",208,0) I DVBNM="patient" S DVBCNT=DVBCNT+1 Q "RTN","DVBAMVI1",209,0) ; "RTN","DVBAMVI1",210,0) I DVBNM="id",$E(DVBATTR("extension"),1,4)="MCID" Q "RTN","DVBAMVI1",211,0) I DVBNM="id",DVBATTR("extension")?3N.NA Q "RTN","DVBAMVI1",212,0) I DVBNM="id",DVBATTR("extension")="" Q "RTN","DVBAMVI1",213,0) ; "RTN","DVBAMVI1",214,0) ;set ICN "RTN","DVBAMVI1",215,0) I DVBNM="id",DVBATTR("extension")["NI^200M^USVHA^P" D Q "RTN","DVBAMVI1",216,0) . S DVBOUT(DVBCNT,"ICN")=$P(DVBATTR("extension"),U,1,4) "RTN","DVBAMVI1",217,0) ; "RTN","DVBAMVI1",218,0) ;set SSN "RTN","DVBAMVI1",219,0) I DVBNM="id",DVBATTR("extension")["^SS" D Q "RTN","DVBAMVI1",220,0) . S DVBOUT(DVBCNT,"SSN")=$P(DVBATTR("extension"),U,1) "RTN","DVBAMVI1",221,0) ; "RTN","DVBAMVI1",222,0) ;set DOB "RTN","DVBAMVI1",223,0) I DVBNM="birthTime" D Q "RTN","DVBAMVI1",224,0) . S DVBOUT(DVBCNT,"DOB")=$$FMTE^XLFDT($$HL7TFM^XLFDT($G(DVBATTR("value"))),"5Z") "RTN","DVBAMVI1",225,0) ; "RTN","DVBAMVI1",226,0) ;set Name to start collecting name field data "RTN","DVBAMVI1",227,0) I DVBNM="name",DVBATTR("use")="L" D "RTN","DVBAMVI1",228,0) . S DVBVAR="NAME" "RTN","DVBAMVI1",229,0) . S DVBOUT(DVBCNT,DVBVAR)="" "RTN","DVBAMVI1",230,0) ; "RTN","DVBAMVI1",231,0) ;set Family Name when using Last,First Middle format "RTN","DVBAMVI1",232,0) I DVBFRMT,DVBNM="family",DVBVAR="NAME" D "RTN","DVBAMVI1",233,0) . S DVBVAR="FAMILY" "RTN","DVBAMVI1",234,0) . S DVBOUT(DVBCNT,DVBVAR)="" "RTN","DVBAMVI1",235,0) ; "RTN","DVBAMVI1",236,0) ;response code "RTN","DVBAMVI1",237,0) I DVBNM="queryResponseCode",$G(DVBOUT(0))="" D Q "RTN","DVBAMVI1",238,0) . S DVBOUT(0)=$S(DVBATTR("code")="NF":"No match found for patient",DVBATTR("code")="QE":"More than 10 potential matches found",1:DVBATTR("code")) "RTN","DVBAMVI1",239,0) ; "RTN","DVBAMVI1",240,0) ;set acknowledgementDetail "RTN","DVBAMVI1",241,0) I DVBNM="acknowledgementDetail" D Q "RTN","DVBAMVI1",242,0) . S DVBVAR="ACKNOWLEDGEMENTDETAIL" "RTN","DVBAMVI1",243,0) . S DVBOUT(DVBCNT,DVBVAR)="" "RTN","DVBAMVI1",244,0) ; "RTN","DVBAMVI1",245,0) Q "RTN","DVBAMVI1",246,0) ; "RTN","DVBAMVI1",247,0) VALUE(DVBTXT) ; - used by the parser to call back with CHARACTERS "RTN","DVBAMVI1",248,0) I DVBVAR'="" D "RTN","DVBAMVI1",249,0) . S DVBOUT(DVBCNT,DVBVAR)=DVBOUT(DVBCNT,DVBVAR)_$S($L(DVBOUT(DVBCNT,DVBVAR)):" ",1:"")_DVBTXT "RTN","DVBAMVI1",250,0) Q "RTN","DVBAMVI1",251,0) ; "RTN","DVBAMVI1",252,0) EE(DVBNM) ; - used for the the parser to call back with ENDELEMENT "RTN","DVBAMVI1",253,0) ; "RTN","DVBAMVI1",254,0) ; prevent any undefined errors "RTN","DVBAMVI1",255,0) S DVBNM=$G(DVBNM) "RTN","DVBAMVI1",256,0) ; "RTN","DVBAMVI1",257,0) ;set back to "NAME" to append any suffix onto given name - only "RTN","DVBAMVI1",258,0) ;used for Last,First Middle Suffix format "RTN","DVBAMVI1",259,0) I DVBNM="family",DVBVAR="FAMILY" S DVBVAR="NAME" Q "RTN","DVBAMVI1",260,0) ; "RTN","DVBAMVI1",261,0) ;stop reading name fields "RTN","DVBAMVI1",262,0) I DVBNM="name",DVBVAR="NAME" S DVBVAR="" Q "RTN","DVBAMVI1",263,0) ; "RTN","DVBAMVI1",264,0) ;stop reading acknowledgmentDetail field "RTN","DVBAMVI1",265,0) I DVBNM="acknowledgementDetail",DVBVAR="ACKNOWLEDGEMENTDETAIL" S DVBVAR="" Q "RTN","DVBAMVI1",266,0) ; "RTN","DVBAMVI1",267,0) Q "RTN","DVBAMVI1",268,0) ; "RTN","DVBAMVI1",269,0) OUTPUT(DVBIN,DVBOUT) ; "RTN","DVBAMVI1",270,0) ;This procedure formats the individual record lines and builds "RTN","DVBAMVI1",271,0) ;the results array output for the remote procedure. "RTN","DVBAMVI1",272,0) ; "RTN","DVBAMVI1",273,0) N DVBCNT ;line count "RTN","DVBAMVI1",274,0) N DVBTOT ;total lines "RTN","DVBAMVI1",275,0) S DVBCNT=0 "RTN","DVBAMVI1",276,0) S DVBTOT=0 "RTN","DVBAMVI1",277,0) F S DVBCNT=$O(DVBIN(DVBCNT)) Q:'DVBCNT D "RTN","DVBAMVI1",278,0) . S DVBTOT=DVBTOT+1 "RTN","DVBAMVI1",279,0) . I DVBFRMT D ;Last,First Middle Suffix "RTN","DVBAMVI1",280,0) . . S DVBOUT(DVBCNT)=$G(DVBIN(DVBCNT,"FAMILY"))_","_$G(DVBIN(DVBCNT,"NAME")) "RTN","DVBAMVI1",281,0) . E D ;First Middle Last Suffix "RTN","DVBAMVI1",282,0) . . S DVBOUT(DVBCNT)=$G(DVBIN(DVBCNT,"NAME")) "RTN","DVBAMVI1",283,0) . S DVBOUT(DVBCNT)=DVBOUT(DVBCNT)_U_$G(DVBIN(DVBCNT,"SSN")) "RTN","DVBAMVI1",284,0) . S DVBOUT(DVBCNT)=DVBOUT(DVBCNT)_U_$G(DVBIN(DVBCNT,"DOB")) "RTN","DVBAMVI1",285,0) . S DVBOUT(DVBCNT)=DVBOUT(DVBCNT)_U_$G(DVBIN(DVBCNT,"ICN")) "RTN","DVBAMVI1",286,0) I $G(DVBIN(0))="AE" D "RTN","DVBAMVI1",287,0) . S DVBOUT(0)=DVBTOT_U_"Acknowledgement Error: "_$G(DVBIN(0,"ACKNOWLEDGEMENTDETAIL")) "RTN","DVBAMVI1",288,0) E D "RTN","DVBAMVI1",289,0) . S DVBOUT(0)=DVBTOT_U_$G(DVBIN(0)) "RTN","DVBAMVI1",290,0) Q "RTN","DVBAMVI2") 0^8^B42005360^n/a "RTN","DVBAMVI2",1,0) DVBAMVI2 ;ALB/RPM - CAPRI MVI GET CORRESPONDING IDS ;8/6/2012 "RTN","DVBAMVI2",2,0) ;;2.7;AMIE;**181**;Apr 10, 1995;Build 38 "RTN","DVBAMVI2",3,0) ; Get Corresponding Ids is a function of the MVI service, "RTN","DVBAMVI2",4,0) ; used to retrieve all known MVI Identifiers as they relate "RTN","DVBAMVI2",5,0) ; to a source identifier. The transaction grouping for this "RTN","DVBAMVI2",6,0) ; interaction is a 1309 Request and 1310 Response. "RTN","DVBAMVI2",7,0) ; "RTN","DVBAMVI2",8,0) Q ;NO DIRECT ENTRY "RTN","DVBAMVI2",9,0) ; "RTN","DVBAMVI2",10,0) GETIDS(DVBRSLT,DVBIID) ; "RTN","DVBAMVI2",11,0) ;This procedure supports the DVBA MVI GET CORRESPONDING IDS remote "RTN","DVBAMVI2",12,0) ;procedure. An MVI patient identifier string is passed to the procedure. "RTN","DVBAMVI2",13,0) ;The procedure generates a 1309 Get Corresponding IDs HL7v3 request "RTN","DVBAMVI2",14,0) ;message and transmits it to the MVI. A list of station numbers is "RTN","DVBAMVI2",15,0) ;returned in a 1310 HL7v3 message to represent the treating facility list. "RTN","DVBAMVI2",16,0) ;The INSTITUTION (#4) file IEN, station name, and station number is "RTN","DVBAMVI2",17,0) ;returned for each treating facility. "RTN","DVBAMVI2",18,0) ; "RTN","DVBAMVI2",19,0) ; Input: "RTN","DVBAMVI2",20,0) ; DVBRSLT - RPC results parameter defined as an ARRAY "RTN","DVBAMVI2",21,0) ; DVBIID = Patient identifier delimited using "^" "RTN","DVBAMVI2",22,0) ; Piece 1: Id "RTN","DVBAMVI2",23,0) ; Piece 2: IdType "RTN","DVBAMVI2",24,0) ; Piece 3: Assigning location "RTN","DVBAMVI2",25,0) ; Piece 4: Assigning issuer "RTN","DVBAMVI2",26,0) ; "RTN","DVBAMVI2",27,0) ; Example: 1008523099V750710^NI^200M^USVHA "RTN","DVBAMVI2",28,0) ; "RTN","DVBAMVI2",29,0) ; Output: "RTN","DVBAMVI2",30,0) ; DVBRSLT - array of lines each containing station IEN, name , "RTN","DVBAMVI2",31,0) ; and station number delimited by a caret ("^"). The "RTN","DVBAMVI2",32,0) ; first array node contains the total number of stations "RTN","DVBAMVI2",33,0) ; returned and the query response. "RTN","DVBAMVI2",34,0) ; "RTN","DVBAMVI2",35,0) ; Format: instutionIEN^stationName^stationNumber "RTN","DVBAMVI2",36,0) ; "RTN","DVBAMVI2",37,0) ; Example: DVBOUT(0)=2^OK "RTN","DVBAMVI2",38,0) ; DVBOUT(1)="516^BAY PINES VA HCS^516" "RTN","DVBAMVI2",39,0) ; DVBOUT(2)="523^BOSTON HCS VAMC^523" "RTN","DVBAMVI2",40,0) ; "RTN","DVBAMVI2",41,0) N DVBPRS ;parsed results array "RTN","DVBAMVI2",42,0) N DVBXML ;1309 HL7v3 XML request "RTN","DVBAMVI2",43,0) N DVBXMLR ;1310 HL7v3 XML results "RTN","DVBAMVI2",44,0) ; "RTN","DVBAMVI2",45,0) ;create the 1309 request message "RTN","DVBAMVI2",46,0) S DVBXML=$$CRE81309(DVBIID) "RTN","DVBAMVI2",47,0) ; "RTN","DVBAMVI2",48,0) ;transmit the message to the MVI "RTN","DVBAMVI2",49,0) D XMIT(DVBXML,.DVBXMLR) "RTN","DVBAMVI2",50,0) ; "RTN","DVBAMVI2",51,0) ;parse the returned 1310 result message "RTN","DVBAMVI2",52,0) I $D(DVBXMLR) D "RTN","DVBAMVI2",53,0) . D PARSE(.DVBXMLR,.DVBPRS) "RTN","DVBAMVI2",54,0) . ; "RTN","DVBAMVI2",55,0) . ;format the output array "RTN","DVBAMVI2",56,0) . D OUTPUT(.DVBPRS,.DVBRSLT) "RTN","DVBAMVI2",57,0) E D "RTN","DVBAMVI2",58,0) . S DVBRSLT(0)=0_U_"Communication error occurred" "RTN","DVBAMVI2",59,0) Q "RTN","DVBAMVI2",60,0) ; "RTN","DVBAMVI2",61,0) CRE81309(DVBIID) ; create 1309 request xml document "RTN","DVBAMVI2",62,0) ; This function creates the HL7v3 1309 Get Corresponding IDs "RTN","DVBAMVI2",63,0) ; Request xml document. "RTN","DVBAMVI2",64,0) ; "RTN","DVBAMVI2",65,0) ; DVBIID = Patient identifier delimited using "^" "RTN","DVBAMVI2",66,0) ; Piece 1: Id "RTN","DVBAMVI2",67,0) ; Piece 2: IdType "RTN","DVBAMVI2",68,0) ; Piece 3: Assigning location "RTN","DVBAMVI2",69,0) ; Piece 4: Assigning issuer "RTN","DVBAMVI2",70,0) ; "RTN","DVBAMVI2",71,0) ; ex. 1008523099V750710^NI^200M^USVHA "RTN","DVBAMVI2",72,0) ; "RTN","DVBAMVI2",73,0) ; Returns formatted XML for the search "RTN","DVBAMVI2",74,0) ; "RTN","DVBAMVI2",75,0) ; $$PARAM^HLCS2 - #3552 (need) "RTN","DVBAMVI2",76,0) ; "RTN","DVBAMVI2",77,0) N DVBSKEY ;site key "RTN","DVBAMVI2",78,0) N DVBPCODE ;HL7 processing code "RTN","DVBAMVI2",79,0) N MPIXML ;function result "RTN","DVBAMVI2",80,0) ; "RTN","DVBAMVI2",81,0) S DVBPCODE=$P($$PARAM^HLCS2,"^",3) "RTN","DVBAMVI2",82,0) S DVBSKEY="200CAPR" "RTN","DVBAMVI2",83,0) ; "RTN","DVBAMVI2",84,0) ;Header "RTN","DVBAMVI2",85,0) S MPIXML="" "RTN","DVBAMVI2",91,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",93,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",94,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",96,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",97,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",98,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",99,0) ; "RTN","DVBAMVI2",100,0) ; start "RTN","DVBAMVI2",101,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",102,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",103,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",104,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",105,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",106,0) ; "RTN","DVBAMVI2",107,0) ; start "RTN","DVBAMVI2",108,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",109,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",110,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",111,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",112,0) ; "RTN","DVBAMVI2",113,0) ; start "RTN","DVBAMVI2",114,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",116,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",118,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",120,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",121,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",122,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",123,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",124,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",125,0) S MPIXML=MPIXML_"Patient.Id" "RTN","DVBAMVI2",126,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",127,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",128,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",129,0) S MPIXML=MPIXML_"" "RTN","DVBAMVI2",130,0) Q MPIXML "RTN","DVBAMVI2",131,0) ; "RTN","DVBAMVI2",132,0) XMIT(DVBXML,DVBXMLR) ; "RTN","DVBAMVI2",133,0) ; "RTN","DVBAMVI2",134,0) ; $$GETPROXY^XOBWLIB - #5421 "RTN","DVBAMVI2",135,0) ; "RTN","DVBAMVI2",136,0) N $ETRAP,$ESTACK,SVC "RTN","DVBAMVI2",137,0) ; "RTN","DVBAMVI2",138,0) ; set error trap "RTN","DVBAMVI2",139,0) S $ETRAP="DO ERROR^DVBAHWSC" "RTN","DVBAMVI2",140,0) ; "RTN","DVBAMVI2",141,0) ; make the call "RTN","DVBAMVI2",142,0) S SVC=$$GETPROXY^XOBWLIB("DVB_PSIM_EXECUTE","DVB_MVI_SERVER") "RTN","DVBAMVI2",143,0) S DVBXMLR=SVC.execute(DVBXML) "RTN","DVBAMVI2",144,0) ; "RTN","DVBAMVI2",145,0) Q "RTN","DVBAMVI2",146,0) ; "RTN","DVBAMVI2",147,0) PARSE(DVBXML,DVBOUT) ; "RTN","DVBAMVI2",148,0) ; "RTN","DVBAMVI2",149,0) ; EN^MXMLPRSE - #4149 "RTN","DVBAMVI2",150,0) ; "RTN","DVBAMVI2",151,0) K ^TMP($J,"DVBAMVI2") "RTN","DVBAMVI2",152,0) N DVBCB ;parser callback array "RTN","DVBAMVI2",153,0) N DVBCNT ;record counter "RTN","DVBAMVI2",154,0) S DVBCNT=0 "RTN","DVBAMVI2",155,0) S DVBCB("STARTELEMENT")="SE^DVBAMVI2" "RTN","DVBAMVI2",156,0) S ^TMP($J,"DVBAMVI2",1)=DVBXML "RTN","DVBAMVI2",157,0) D EN^MXMLPRSE($NA(^TMP($J,"DVBAMVI2")),.DVBCB) "RTN","DVBAMVI2",158,0) K ^TMP($J,"DVBAMVI2") "RTN","DVBAMVI2",159,0) Q "RTN","DVBAMVI2",160,0) ; "RTN","DVBAMVI2",161,0) SE(DVBNM,DVBATTR) ; - used for the parser to call back with STARTELEMENT "RTN","DVBAMVI2",162,0) ; "RTN","DVBAMVI2",163,0) ; prevent any undefined errors "RTN","DVBAMVI2",164,0) S DVBNM=$G(DVBNM) "RTN","DVBAMVI2",165,0) S DVBATTR("extension")=$G(DVBATTR("extension")) "RTN","DVBAMVI2",166,0) ; "RTN","DVBAMVI2",167,0) ; "RTN","DVBAMVI2",168,0) I DVBNM="id",$E(DVBATTR("extension"),1,4)="MCID" Q "RTN","DVBAMVI2",169,0) I DVBNM="id",DVBATTR("extension")?3N.NA Q "RTN","DVBAMVI2",170,0) I DVBNM="id",DVBATTR("extension")="" Q "RTN","DVBAMVI2",171,0) I DVBNM="id",DVBATTR("extension")["NI^200M^USVHA^P" Q "RTN","DVBAMVI2",172,0) ; "RTN","DVBAMVI2",173,0) ;response code "RTN","DVBAMVI2",174,0) I DVBNM="queryResponseCode",$G(DVBOUT(0))="" D Q "RTN","DVBAMVI2",175,0) . S DVBOUT(0)=$S(DVBATTR("code")="NF":"No match found for "_DVBIID,1:DVBATTR("code")) "RTN","DVBAMVI2",176,0) ; "RTN","DVBAMVI2",177,0) ;set station numbers "RTN","DVBAMVI2",178,0) ;pattern match DFN_"^PI^"_stationNumber_"^USVHA^"_alpha "RTN","DVBAMVI2",179,0) I DVBNM="id",DVBATTR("extension")?1.N1"^PI^"2N.NA1"^USVHA^".A D Q "RTN","DVBAMVI2",180,0) . S DVBOUT($P(DVBATTR("extension"),U,3))="" "RTN","DVBAMVI2",181,0) Q "RTN","DVBAMVI2",182,0) ; "RTN","DVBAMVI2",183,0) OUTPUT(DVBIN,DVBOUT) ; "RTN","DVBAMVI2",184,0) ;This procedure formats the individual record lines and builds "RTN","DVBAMVI2",185,0) ;the results array output for the remote procedure. "RTN","DVBAMVI2",186,0) ; "RTN","DVBAMVI2",187,0) ; Input: "RTN","DVBAMVI2",188,0) ; DVBIN - array of station numbers "RTN","DVBAMVI2",189,0) ; "RTN","DVBAMVI2",190,0) ; Output: "RTN","DVBAMVI2",191,0) ; DVBOUT - array of lines each containing station IEN, name , "RTN","DVBAMVI2",192,0) ; and station number delimited by a caret ("^"). The "RTN","DVBAMVI2",193,0) ; first array node contains the returned station count "RTN","DVBAMVI2",194,0) ; and the query response. "RTN","DVBAMVI2",195,0) ; "RTN","DVBAMVI2",196,0) ; Example: DVBOUT(0)=2^OK "RTN","DVBAMVI2",197,0) ; DVBOUT(1)="516^BAY PINES VA HCS^516" "RTN","DVBAMVI2",198,0) ; DVBOUT(2)="523^BOSTON HCS VAMC^523" "RTN","DVBAMVI2",199,0) ; "RTN","DVBAMVI2",200,0) N DVBSTA ;station number "RTN","DVBAMVI2",201,0) N DVBCNT ;results counter "RTN","DVBAMVI2",202,0) N DVBIEN ;INSTITUTION (#4) file IEN "RTN","DVBAMVI2",203,0) S DVBSTA="" "RTN","DVBAMVI2",204,0) S DVBCNT=0 "RTN","DVBAMVI2",205,0) F S DVBSTA=$O(DVBIN(DVBSTA)) Q:(DVBSTA="") D "RTN","DVBAMVI2",206,0) . S DVBIEN=+$$IEN^XUAF4(DVBSTA) "RTN","DVBAMVI2",207,0) . I DVBIEN D "RTN","DVBAMVI2",208,0) . . S DVBCNT=DVBCNT+1 "RTN","DVBAMVI2",209,0) . . S DVBOUT(DVBCNT)=DVBIEN_U_$$NS^XUAF4(DVBIEN) "RTN","DVBAMVI2",210,0) S DVBOUT(0)=DVBCNT_U_$G(DVBIN(0)) "RTN","DVBAMVI2",211,0) Q "RTN","DVBANTFY") 0^3^B2472090^n/a "RTN","DVBANTFY",1,0) DVBANTFY ;ALB/DJS - FORM 28-8861 REQUEST FOR MEDICAL SERVICES MAILMAN NOTIFICATIONS ;7/2/12 5:09PM "RTN","DVBANTFY",2,0) ;;2.7;AMIE;**181**;Apr 10, 1995;Build 38 "RTN","DVBANTFY",3,0) ; "RTN","DVBANTFY",4,0) Q ;no direct entry "RTN","DVBANTFY",5,0) ; "RTN","DVBANTFY",6,0) ENTER(RETURN,IEN,STAT) ; determine which MailMan message will be sent and to whom based on what the request status is. "RTN","DVBANTFY",7,0) ; "RTN","DVBANTFY",8,0) ; Input: "RTN","DVBANTFY",9,0) ; IEN - internal record number of 8861 request "RTN","DVBANTFY",10,0) ; STAT - request status "RTN","DVBANTFY",11,0) ; "RTN","DVBANTFY",12,0) Q:(STAT="")!(IEN="") "RTN","DVBANTFY",13,0) I STAT="NEW" D RPCIN^DVBAVRX1(IEN,"NEW") ; Send New notification to VHA Coordinator "RTN","DVBANTFY",14,0) I STAT="PENDING" D RPCIN^DVBAVRX1(IEN,"PND") ; Send Pending notification to vha Coordinator and VR&E staff "RTN","DVBANTFY",15,0) I STAT="CANCELLED" D RPCIN^DVBAVRX1(IEN,"CAN") ; Send Cancelled notification to VHA Coordinator and VR&E staff "RTN","DVBANTFY",16,0) S RETURN=1 "RTN","DVBANTFY",17,0) Q "RTN","DVBAVRX1") 0^4^B93077870^n/a "RTN","DVBAVRX1",1,0) DVBAVRX1 ;ALB/GAK - CAPRI BACKGROUND JOB2 AND RPC ENTRY POINT FOR VOCREHAB ;06/21/2012 12:00pm "RTN","DVBAVRX1",2,0) ;;2.7;AMIE;**181**;Apr 10, 1995;Build 38 "RTN","DVBAVRX1",3,0) ; "RTN","DVBAVRX1",4,0) Q ;NO DIRECT ENTRY "RTN","DVBAVRX1",5,0) ; "RTN","DVBAVRX1",6,0) ; RUN FROM TASK MANAGER (BACKGROUND BATCH JOB) "RTN","DVBAVRX1",7,0) ; BACKGROUND JOB SHOULD BE RUN ON SAME DAY AS DATA ENTRY AT THE END OF THE BUSINESS DAY "RTN","DVBAVRX1",8,0) ; CALL INDIVIDUAL TAGS FROM RPC (MAILMAN NOTIFY - REALTIME) "RTN","DVBAVRX1",9,0) ; "RTN","DVBAVRX1",10,0) ;FOR BUILD: "RTN","DVBAVRX1",11,0) ; MAILMAN GROUP -> "DVBA VR VOCREHAB PERSONNEL" "RTN","DVBAVRX1",12,0) ; OPTION FILE OPTION -> "DVBA VR BACKGROUND" "RTN","DVBAVRX1",13,0) ; RPC -> NEW REQUEST "RTN","DVBAVRX1",14,0) ; RPC -> CANCELLED REQUEST "RTN","DVBAVRX1",15,0) ; RPC -> COMPLETED REQUEST "RTN","DVBAVRX1",16,0) ; RPC -> PENDING REQUEST "RTN","DVBAVRX1",17,0) ; "RTN","DVBAVRX1",18,0) EN ; TASKMAN ENTER POINT FOR BACKGROUND JOB "RTN","DVBAVRX1",19,0) ; "RTN","DVBAVRX1",20,0) D JOB1^DVBAVRX2 ; For "N"ew status based on the INDEX - age entries and alert users of un-linked requests. "RTN","DVBAVRX1",21,0) D JOB2 ; LOOK AT STATUS OF FILE 123 --> 100.01 AND WORK MAIL NOTIFICATIONS "RTN","DVBAVRX1",22,0) ; "RTN","DVBAVRX1",23,0) Q "RTN","DVBAVRX1",24,0) ; "RTN","DVBAVRX1",25,0) JOB2 ;JOB 2 WILL LOOK AT STATUS OF CONSULTS LINKED TO 8861 "RTN","DVBAVRX1",26,0) ; WHEN ALL CONSULTS AS CANCELLED - FORM 8861 WILL BE CANCELLED "RTN","DVBAVRX1",27,0) ; WHEN A CONSULT IS COMPLETED AND IS THE ONLY CONSULT LINKED TO THE FORM - FORM 8861 WILL BE COMPLETED "RTN","DVBAVRX1",28,0) ; WHEN A CONSULT IS COMPLETED AND ALL OTHER CONSULTS ARE COMPLETE OR CANCLLED - FORM 8861 WILL BE COMPLETED "RTN","DVBAVRX1",29,0) ; "RTN","DVBAVRX1",30,0) N %H,DAT,X,J "RTN","DVBAVRX1",31,0) N DVBADAT,DVBAIEN,DVBAIENX "RTN","DVBAVRX1",32,0) N DVBACARY ;CONSULTS ARRAY "RTN","DVBAVRX1",33,0) N DVBACERR ;CONSULTS GETS ERROR ARRAY "RTN","DVBAVRX1",34,0) N DVBAIENT ;IEN OF FORM 8831 CONTAINED IN THE CONSULTS ARRAY (TOP) "RTN","DVBAVRX1",35,0) N DVBAMLTN ;SEQUENCE NUMBER OF FORM 8861 MULTI CONTAINED IN THE CONSULTS ARRAY (MULTI SEQUENTIAL NUMBER) "RTN","DVBAVRX1",36,0) N DVBATMP1 ;TEMP ARRAY 1 - CONSULTS MULTI "RTN","DVBAVRX1",37,0) N DVBARCST ;CONSULT/REQUEST STATUS --> 100.01,.001 "RTN","DVBAVRX1",38,0) N DVBAVRST ;VOCREHAB STATUS OF MULTI (396.914,.02) "RTN","DVBAVRX1",39,0) N DVBARKEY ;REVERSE THE IEN KEYS AGAIN "RTN","DVBAVRX1",40,0) N DVBACC ;ARRAY FOR CANCELLED / COMPLETE LOGIC "RTN","DVBAVRX1",41,0) N DVBAFDA ;UPDATE API ARRAY "RTN","DVBAVRX1",42,0) N DVBATD ;TODAY'S DATE "RTN","DVBAVRX1",43,0) N DVBACAN,DVBACOM "RTN","DVBAVRX1",44,0) ; "RTN","DVBAVRX1",45,0) S DVBADAT="" F S DVBADAT=$O(^DVB(396.9,"ARSDT","P",DVBADAT)) Q:DVBADAT="" D "RTN","DVBAVRX1",46,0) . S DVBAIEN="" F S DVBAIEN=$O(^DVB(396.9,"ARSDT","P",DVBADAT,DVBAIEN)) Q:DVBAIEN="" D "RTN","DVBAVRX1",47,0) .. ;GET CONSULT INFO AND BUILD CONSULT ARRAY "RTN","DVBAVRX1",48,0) .. K DVBATMP1 "RTN","DVBAVRX1",49,0) .. K DVBACARY "RTN","DVBAVRX1",50,0) .. D GETS^DIQ(396.9,DVBAIEN,"14*","IE","DVBACARY","DVBACERR") "RTN","DVBAVRX1",51,0) .. S J="" F S J=$O(DVBACARY(396.914,J)) Q:J="" D "RTN","DVBAVRX1",52,0) ... S DVBAIENT=$P(J,",",2) ;SHOULD ALWAYS BE THE SAME AS IEN "RTN","DVBAVRX1",53,0) ... S DVBAMLTN=$P(J,",",1) "RTN","DVBAVRX1",54,0) ... ;BUILD TEMP ARRAY OF MULTI "RTN","DVBAVRX1",55,0) ... S DVBATMP1(DVBAIENT,DVBAMLTN,.01,"I")=$G(DVBACARY(396.914,J,.01,"I")) "RTN","DVBAVRX1",56,0) ... S DVBATMP1(DVBAIENT,DVBAMLTN,.02,"I")=$G(DVBACARY(396.914,J,.02,"I")) "RTN","DVBAVRX1",57,0) .. ;WORK TEMP ARRAY "RTN","DVBAVRX1",58,0) .. ;$P1 = VALUE FORM FORM ARRAY ^ $P2 = VALUE FROM CONSULTS -> STATUS #123; field 8 (internal value) "RTN","DVBAVRX1",59,0) .. S DVBAIENT="" "RTN","DVBAVRX1",60,0) .. K DVBACC "RTN","DVBAVRX1",61,0) .. F S DVBAIENT=$O(DVBATMP1(DVBAIENT)) Q:DVBAIENT="" D "RTN","DVBAVRX1",62,0) ... S DVBAMLTN="" "RTN","DVBAVRX1",63,0) ... F S DVBAMLTN=$O(DVBATMP1(DVBAIENT,DVBAMLTN)) Q:DVBAMLTN="" D "RTN","DVBAVRX1",64,0) .... S DVBARKEY=DVBAMLTN_","_DVBAIENT "RTN","DVBAVRX1",65,0) .... S DVBAVRST=$$GET1^DIQ(396.914,DVBARKEY,.02,"I") "RTN","DVBAVRX1",66,0) .... ;ICR #4110 "RTN","DVBAVRX1",67,0) .... S DVBAIENX=DVBATMP1(DVBAIENT,DVBAMLTN,.01,"I") "RTN","DVBAVRX1",68,0) .... S DVBARCST=$$GET1^DIQ(123,DVBAIENX,8,"I") ;IEN OF THE 123 FILE VR IS POINTING TO "RTN","DVBAVRX1",69,0) .... ; "RTN","DVBAVRX1",70,0) .... I DVBARCST=1 S DVBACC(DVBARCST)="" "RTN","DVBAVRX1",71,0) .... I DVBARCST=2 S DVBACC(DVBARCST)="" "RTN","DVBAVRX1",72,0) .... I DVBARCST'=1&(DVBARCST'=2) S DVBACC(0)="" "RTN","DVBAVRX1",73,0) .... ; "RTN","DVBAVRX1",74,0) .... I DVBARCST'=DVBAVRST D ;UPDATE VOCREHAB LAST STATUS "RTN","DVBAVRX1",75,0) ..... K DVBAFDA "RTN","DVBAVRX1",76,0) ..... S DVBAFDA(1,396.914,DVBARKEY_",",.02)=DVBARCST "RTN","DVBAVRX1",77,0) ..... ;IRC #875 - points to 100.01 "RTN","DVBAVRX1",78,0) ..... D UPDATE^DIE("","DVBAFDA(1)","","DVBAUERR") "RTN","DVBAVRX1",79,0) ..... I $D(DVBAUERR) Q "RTN","DVBAVRX1",80,0) ... S DVBACOM=0 ;COMPLETED SWITCH "RTN","DVBAVRX1",81,0) ... S DVBACAN=0 ;CANCELLED SWITCH "RTN","DVBAVRX1",82,0) ... D ;multi logic, should it ever be needed "RTN","DVBAVRX1",83,0) .... I $D(DVBACC(0)) Q "RTN","DVBAVRX1",84,0) .... I $D(DVBACC(1))&($D(DVBACC(2))) S DVBACOM=1 Q "RTN","DVBAVRX1",85,0) .... I $D(DVBACC(1)) S DVBACAN=1 Q "RTN","DVBAVRX1",86,0) .... I $D(DVBACC(2)) S DVBACOM=1 Q "RTN","DVBAVRX1",87,0) ... I DVBACAN=1 D "RTN","DVBAVRX1",88,0) .... K DVBAFDA,DVBAUERR "RTN","DVBAVRX1",89,0) .... S DVBAFDA(1,396.9,DVBAIENT_",",13)="X" "RTN","DVBAVRX1",90,0) .... K %H,DAT,X "RTN","DVBAVRX1",91,0) .... S (%H,DAT)=+$H D YMD^%DTC ;CONVERT $H TO FILEMAN DATE "RTN","DVBAVRX1",92,0) .... S DVBAFDA(1,396.9,DVBAIENT_",",15)=X "RTN","DVBAVRX1",93,0) .... S DVBAFDA(1,396.9,DVBAIENT_",",16)="OTH" "RTN","DVBAVRX1",94,0) .... D UPDATE^DIE("","DVBAFDA(1)","","DVBAUERR") "RTN","DVBAVRX1",95,0) .... I $D(DVBAUERR) Q "RTN","DVBAVRX1",96,0) .... D RPCIN(DVBAIEN,"CAN") "RTN","DVBAVRX1",97,0) ... I DVBACOM=1 D "RTN","DVBAVRX1",98,0) .... K DVBAFDA,DVBAUERR "RTN","DVBAVRX1",99,0) .... S DVBAFDA(1,396.9,DVBAIENT_",",13)="C" "RTN","DVBAVRX1",100,0) .... K %H,DAT,X "RTN","DVBAVRX1",101,0) .... S (%H,DAT)=+$H D YMD^%DTC ;CONVERT $H TO FILEMAN DATE "RTN","DVBAVRX1",102,0) .... S DVBAFDA(1,396.9,DVBAIENT_",",2)=X "RTN","DVBAVRX1",103,0) .... D UPDATE^DIE("","DVBAFDA(1)","","DVBAUERR") "RTN","DVBAVRX1",104,0) .... I $D(DVBAUERR) Q "RTN","DVBAVRX1",105,0) .... D RPCIN(DVBAIEN,"COM") "RTN","DVBAVRX1",106,0) ; "RTN","DVBAVRX1",107,0) Q "RTN","DVBAVRX1",108,0) ; "RTN","DVBAVRX1",109,0) RPCIN(DVBAFIEN,DVBATYPE) ;ENTER (IN) POINT FOR RPC CALLS "RTN","DVBAVRX1",110,0) ; "RTN","DVBAVRX1",111,0) ;Parameters Passed In "RTN","DVBAVRX1",112,0) ;DVBAFIEN The IEN of the 8861 Form "RTN","DVBAVRX1",113,0) ;DVBATYPE The type of the mailman message to be sent "RTN","DVBAVRX1",114,0) ; 'NEW' "RTN","DVBAVRX1",115,0) ; 'PENDING' "RTN","DVBAVRX1",116,0) ; 'CANCELLED' "RTN","DVBAVRX1",117,0) ; "RTN","DVBAVRX1",118,0) N XMDUZ,DVBADUZ "RTN","DVBAVRX1",119,0) ; "RTN","DVBAVRX1",120,0) I '$D(DUZ) Q "RTN","DVBAVRX1",121,0) ; "RTN","DVBAVRX1",122,0) S XMDUZ=$P(^VA(200,DUZ,0),"^",1)_" CAPRI" "RTN","DVBAVRX1",123,0) S DVBADUZ=DUZ "RTN","DVBAVRX1",124,0) ; "RTN","DVBAVRX1",125,0) I DVBATYPE="NEW" D NFY(DVBAFIEN,"NEW") Q "RTN","DVBAVRX1",126,0) I DVBATYPE="PND" D NFY(DVBAFIEN,"PND") Q "RTN","DVBAVRX1",127,0) I DVBATYPE="COM" D NFY(DVBAFIEN,"COM") Q "RTN","DVBAVRX1",128,0) I DVBATYPE="CAN" D NFY(DVBAFIEN,"CAN") Q "RTN","DVBAVRX1",129,0) ; "RTN","DVBAVRX1",130,0) Q "RTN","DVBAVRX1",131,0) ; "RTN","DVBAVRX1",132,0) NFY(DVBAFIEN,DVBATYPE) ;SETUP MAILMAN MESSAGE BASED ON REQUEST FORM IEN "RTN","DVBAVRX1",133,0) ;D GETS^DIQ TO POPULATE REQUEST INFO "RTN","DVBAVRX1",134,0) ; "RTN","DVBAVRX1",135,0) N Y,%H,% "RTN","DVBAVRX1",136,0) N XMSUB,XMTEXT,XMY,XMDUN,XMZ,XMMG "RTN","DVBAVRX1",137,0) N DVBAFARY,DVBAFERR,DVBASTT,DVBAVRRA,DVBAGERR "RTN","DVBAVRX1",138,0) N DVBAPOC,DVBARDAT,DVBAPDFN,DVBAPNAM,DVBARSTT,DVBASNTL,DVBAXIEN "RTN","DVBAVRX1",139,0) N DVBAMMT,DVBAEMA "RTN","DVBAVRX1",140,0) N DVBANXLN,DVBAXXEN "RTN","DVBAVRX1",141,0) N C,D,D0,DA,DI,DIC,DIE,DILOCKTM,DISYS,DQ,DR,X "RTN","DVBAVRX1",142,0) ; "RTN","DVBAVRX1",143,0) N DUZ "RTN","DVBAVRX1",144,0) S DUZ=.5 ;POSTMASTER "RTN","DVBAVRX1",145,0) ;SINCE MAILMAN DOES NOT ALLOW MESSAGES TO BE SENT FROM USERS WITHOUT ACCESS CODES OR MAILBOXES "RTN","DVBAVRX1",146,0) ;WHICH CAPRI REMOTE USER DO NOT HAVE, WE HAVE TO NEW DUZ AND CHANGE XMDUZ TO THE NAME OF THE USER "RTN","DVBAVRX1",147,0) ;AS A STRING SO THE PROCESS IS STILL LINKED TO THE USER SENDING/TRIGGERING THE MESSAGE "RTN","DVBAVRX1",148,0) ; "RTN","DVBAVRX1",149,0) D GETS^DIQ(396.9,DVBAFIEN,"*","IE","DVBAFARY","DVBAFERR") "RTN","DVBAVRX1",150,0) I $D(DVBAFERR) Q "RTN","DVBAVRX1",151,0) ; "RTN","DVBAVRX1",152,0) S DVBAPOC=$G(DVBAFARY(396.9,DVBAFIEN_",",11,"I")) "RTN","DVBAVRX1",153,0) S DVBARDAT=$G(DVBAFARY(396.9,DVBAFIEN_",",.01,"E")) "RTN","DVBAVRX1",154,0) S DVBAPDFN=$G(DVBAFARY(396.9,DVBAFIEN_",",4,"I")) "RTN","DVBAVRX1",155,0) S DVBARSTT=$G(DVBAFARY(396.9,DVBAFIEN_",",13,"E")) "RTN","DVBAVRX1",156,0) S DVBASNTL=$G(DVBAFARY(396.9,DVBAFIEN_",",1,"E")) "RTN","DVBAVRX1",157,0) ; "RTN","DVBAVRX1",158,0) S %H=$H D YX^%DTC S X=X_% S DVBASTT=$$FMTE^XLFDT(X,"5FPZ") "RTN","DVBAVRX1",159,0) S XMSUB="CAPRI: Chapter 31 Referral for Medical Services New" "RTN","DVBAVRX1",160,0) ; "RTN","DVBAVRX1",161,0) S XMY("G.DVBA VR VOCREHAB PERSONNEL")="" "RTN","DVBAVRX1",162,0) S DVBAEMA="DVBA VR VOCREHAB PERSONNEL" "RTN","DVBAVRX1",163,0) ; "RTN","DVBAVRX1",164,0) I DVBATYPE="NEW" D XNEW "RTN","DVBAVRX1",165,0) I DVBATYPE="PND" D XPND "RTN","DVBAVRX1",166,0) I DVBATYPE="COM" D XCOM "RTN","DVBAVRX1",167,0) I DVBATYPE="CAN" D XCAN "RTN","DVBAVRX1",168,0) ; "RTN","DVBAVRX1",169,0) Q:DVBATYPE="NEW" "RTN","DVBAVRX1",170,0) ; "RTN","DVBAVRX1",171,0) K XMY "RTN","DVBAVRX1",172,0) ; "RTN","DVBAVRX1",173,0) S DVBAXXEN=DVBAFARY(396.9,DVBAFIEN_",",11,"I") "RTN","DVBAVRX1",174,0) S DVBAVRRA=$$GET1^DIQ(200,DVBAXXEN,.151,"","","DVBAGERR") "RTN","DVBAVRX1",175,0) I $D(DVBAGERR) Q "RTN","DVBAVRX1",176,0) S DVBAEMA=DVBAVRRA "RTN","DVBAVRX1",177,0) S XMY(DVBAEMA)="" "RTN","DVBAVRX1",178,0) ; "RTN","DVBAVRX1",179,0) I DVBATYPE="PND" D XPND "RTN","DVBAVRX1",180,0) I DVBATYPE="COM" D XCOM "RTN","DVBAVRX1",181,0) I DVBATYPE="CAN" D XCAN "RTN","DVBAVRX1",182,0) ; "RTN","DVBAVRX1",183,0) Q "RTN","DVBAVRX1",184,0) ; "RTN","DVBAVRX1",185,0) XNEW ; "RTN","DVBAVRX1",186,0) ; "RTN","DVBAVRX1",187,0) S XMSUB="CAPRI: Chapter 31 Referral for Medical Services New" "RTN","DVBAVRX1",188,0) S XMTEXT="DVBAMMT(" "RTN","DVBAVRX1",189,0) S DVBAMMT(1)="Sent: "_DVBASTT "RTN","DVBAVRX1",190,0) S DVBAMMT(2)="To: "_DVBAEMA "RTN","DVBAVRX1",191,0) S DVBAMMT(3)="Subject: "_XMSUB "RTN","DVBAVRX1",192,0) S DVBAMMT(4)="" "RTN","DVBAVRX1",193,0) S DVBAMMT(5)="The following veteran has a New Chapter 31, FORM 28-8861" "RTN","DVBAVRX1",194,0) S DVBAMMT(6)="" "RTN","DVBAVRX1",195,0) S DVBANXLN="" "RTN","DVBAVRX1",196,0) S DVBANXLN=DVBANXLN_"DFN: `"_DVBAPDFN_$E(" ",1,12-$L(DVBAPDFN))_" " "RTN","DVBAVRX1",197,0) S DVBANXLN=DVBANXLN_"Request Date: "_DVBARDAT "RTN","DVBAVRX1",198,0) S DVBAMMT(7)=DVBANXLN "RTN","DVBAVRX1",199,0) S DVBAMMT(10)="" "RTN","DVBAVRX1",200,0) S DVBAMMT(11)="**NOTE: To view the patient using the DFN, paste the DFN number into the" "RTN","DVBAVRX1",201,0) S DVBAMMT(12)="CAPRI Patient Selector 'Patient ID' field to find the patient. Be sure to" "RTN","DVBAVRX1",202,0) S DVBAMMT(13)="include the ' (backward-apostrophe) character." "RTN","DVBAVRX1",203,0) ; "RTN","DVBAVRX1",204,0) D XMZ^XMA2 "RTN","DVBAVRX1",205,0) D ^XMD "RTN","DVBAVRX1",206,0) ; "RTN","DVBAVRX1",207,0) Q "RTN","DVBAVRX1",208,0) ; "RTN","DVBAVRX1",209,0) XCOM ; "RTN","DVBAVRX1",210,0) ; "RTN","DVBAVRX1",211,0) S XMSUB="CAPRI: Chapter 31 Referral for Medical Services Completed" "RTN","DVBAVRX1",212,0) S XMTEXT="DVBAMMT(" "RTN","DVBAVRX1",213,0) S DVBAMMT(1)="Sent: "_DVBASTT "RTN","DVBAVRX1",214,0) S DVBAMMT(2)="To: "_DVBAEMA "RTN","DVBAVRX1",215,0) S DVBAMMT(3)="Subject: "_XMSUB "RTN","DVBAVRX1",216,0) S DVBAMMT(4)="" "RTN","DVBAVRX1",217,0) S DVBAMMT(5)="The following veteran has a Completed Chapter 31, FORM 28-8861" "RTN","DVBAVRX1",218,0) S DVBAMMT(6)="" "RTN","DVBAVRX1",219,0) S DVBANXLN="" "RTN","DVBAVRX1",220,0) S DVBANXLN=DVBANXLN_"DFN: `"_DVBAPDFN_$E(" ",1,12-$L(DVBAPDFN))_" " "RTN","DVBAVRX1",221,0) S DVBANXLN=DVBANXLN_"Request Date: "_DVBARDAT "RTN","DVBAVRX1",222,0) S DVBAMMT(7)=DVBANXLN "RTN","DVBAVRX1",223,0) S DVBAMMT(10)="" "RTN","DVBAVRX1",224,0) S DVBAMMT(11)="**NOTE: To view the patient using the DFN, paste the DFN number into the" "RTN","DVBAVRX1",225,0) S DVBAMMT(12)="CAPRI Patient Selector 'Patient ID' field to find the patient. Be sure to" "RTN","DVBAVRX1",226,0) S DVBAMMT(13)="include the ' (backward-apostrophe) character." "RTN","DVBAVRX1",227,0) ; "RTN","DVBAVRX1",228,0) ;CALL FUNCTION TO BUILD A 'TEXT TO DISPLAY' ARRAY OF CONSULTS "RTN","DVBAVRX1",229,0) ; "RTN","DVBAVRX1",230,0) D XMZ^XMA2 "RTN","DVBAVRX1",231,0) D ^XMD "RTN","DVBAVRX1",232,0) ; "RTN","DVBAVRX1",233,0) Q "RTN","DVBAVRX1",234,0) ; "RTN","DVBAVRX1",235,0) XCAN ; "RTN","DVBAVRX1",236,0) ; "RTN","DVBAVRX1",237,0) S XMSUB="CAPRI: Chapter 31 Referral for Medical Services Cancelled" "RTN","DVBAVRX1",238,0) S XMTEXT="DVBAMMT(" "RTN","DVBAVRX1",239,0) S DVBAMMT(1)="Sent: "_DVBASTT "RTN","DVBAVRX1",240,0) S DVBAMMT(2)="To: "_DVBAEMA "RTN","DVBAVRX1",241,0) S DVBAMMT(3)="Subject: "_XMSUB "RTN","DVBAVRX1",242,0) S DVBAMMT(4)="" "RTN","DVBAVRX1",243,0) S DVBAMMT(5)="The following veteran has a Cancelled Chapter 31, FORM 28-8861" "RTN","DVBAVRX1",244,0) S DVBAMMT(6)="" "RTN","DVBAVRX1",245,0) S DVBANXLN="" "RTN","DVBAVRX1",246,0) S DVBANXLN=DVBANXLN_"DFN: `"_DVBAPDFN_$E(" ",1,12-$L(DVBAPDFN))_" " "RTN","DVBAVRX1",247,0) S DVBANXLN=DVBANXLN_"Request Date: "_DVBARDAT "RTN","DVBAVRX1",248,0) S DVBAMMT(7)=DVBANXLN "RTN","DVBAVRX1",249,0) S DVBAMMT(10)="" "RTN","DVBAVRX1",250,0) S DVBAMMT(11)="**NOTE: To view the patient using the DFN, paste the DFN number into the" "RTN","DVBAVRX1",251,0) S DVBAMMT(12)="CAPRI Patient Selector 'Patient ID' field to find the patient. Be sure to" "RTN","DVBAVRX1",252,0) S DVBAMMT(13)="include the ' (backward-apostrophe) character." "RTN","DVBAVRX1",253,0) ;CALL FUNCTION TO BUILD A 'TEXT TO DISPLAY' ARRAY OF CONSULTS "RTN","DVBAVRX1",254,0) ; "RTN","DVBAVRX1",255,0) D XMZ^XMA2 "RTN","DVBAVRX1",256,0) D ^XMD "RTN","DVBAVRX1",257,0) ; "RTN","DVBAVRX1",258,0) Q "RTN","DVBAVRX1",259,0) ; "RTN","DVBAVRX1",260,0) XPND ; "RTN","DVBAVRX1",261,0) ; "RTN","DVBAVRX1",262,0) S XMSUB="CAPRI: Chapter 31 Referral for Medical Services Pending" "RTN","DVBAVRX1",263,0) S XMTEXT="DVBAMMT(" "RTN","DVBAVRX1",264,0) S DVBAMMT(1)="Sent: "_DVBASTT "RTN","DVBAVRX1",265,0) S DVBAMMT(2)="To: "_DVBAEMA "RTN","DVBAVRX1",266,0) S DVBAMMT(3)="Subject: "_XMSUB "RTN","DVBAVRX1",267,0) S DVBAMMT(4)="" "RTN","DVBAVRX1",268,0) S DVBAMMT(5)="The following veteran has a Pending Chapter 31, FORM 28-8861" "RTN","DVBAVRX1",269,0) S DVBAMMT(6)="" "RTN","DVBAVRX1",270,0) S DVBANXLN="" "RTN","DVBAVRX1",271,0) S DVBANXLN=DVBANXLN_"DFN: `"_DVBAPDFN_$E(" ",1,12-$L(DVBAPDFN))_" " "RTN","DVBAVRX1",272,0) S DVBANXLN=DVBANXLN_"Request Date: "_DVBARDAT "RTN","DVBAVRX1",273,0) S DVBAMMT(7)=DVBANXLN "RTN","DVBAVRX1",274,0) S DVBAMMT(10)="" "RTN","DVBAVRX1",275,0) S DVBAMMT(11)="**NOTE: To view the patient using the DFN, paste the DFN number into the" "RTN","DVBAVRX1",276,0) S DVBAMMT(12)="CAPRI Patient Selector 'Patient ID' field to find the patient. Be sure to" "RTN","DVBAVRX1",277,0) S DVBAMMT(13)="include the ' (backward-apostrophe) character." "RTN","DVBAVRX1",278,0) ;CALL FUNCTION TO BUILD A 'TEXT TO DISPLAY' ARRAY OF CONSULTS "RTN","DVBAVRX1",279,0) ; "RTN","DVBAVRX1",280,0) D XMZ^XMA2 "RTN","DVBAVRX1",281,0) D ^XMD "RTN","DVBAVRX1",282,0) ; "RTN","DVBAVRX1",283,0) Q "RTN","DVBAVRX1",284,0) ; "RTN","DVBAVRX1",285,0) GEMA(IEN) ;GET #200 NEW PERSON INFO - GET EMAIL ADDRESS "RTN","DVBAVRX1",286,0) N DVBAERR,DVBAEMA "RTN","DVBAVRX1",287,0) ; "RTN","DVBAVRX1",288,0) ; IA# 10060 "RTN","DVBAVRX1",289,0) S DVBAEMA=$$GET1^DIQ(200,IEN,".151","I",,"DVBAERR") "RTN","DVBAVRX1",290,0) I '$D(DVBAEMA) Q 0 "RTN","DVBAVRX1",291,0) Q DVBAEMA "RTN","DVBAVRX2") 0^5^B30177401^n/a "RTN","DVBAVRX2",1,0) DVBAVRX2 ;ALB/GAK - CAPRI BACKGROUND JOB1 FOR VOCREHAB ;06/21/2012 12:00pm "RTN","DVBAVRX2",2,0) ;;2.7;AMIE;**181**;Apr 10, 1995;Build 38 "RTN","DVBAVRX2",3,0) ; "RTN","DVBAVRX2",4,0) Q ;NO DIRECT ENTRY "RTN","DVBAVRX2",5,0) ; "RTN","DVBAVRX2",6,0) JOB1 ;PROCESS NEW REQUESTS AND SEND MAILMAN MESSAGES FOR AGED REQUESTS "RTN","DVBAVRX2",7,0) ; "RTN","DVBAVRX2",8,0) N %H,X,Y,%Y,DAT "RTN","DVBAVRX2",9,0) N DVBADAT,DVBAIEN "RTN","DVBAVRX2",10,0) N DVBAFARY ;FORM ARRAY FOR GETS "RTN","DVBAVRX2",11,0) N DVBAFERR ;FORM ARRAY ERROR ARRAY "RTN","DVBAVRX2",12,0) N DVBAPOC,DVBARDAT,DVBAPNAM,DVBAPDFN,DVBAPSSN,DVBAPSDT,DVBASNTL "RTN","DVBAVRX2",13,0) N DVBAOK ;OKAY TO PASS PII TO MAILMAN MESSAGE "RTN","DVBAVRX2",14,0) N DVBAGERR ;GET1 ERROR ARRAY "RTN","DVBAVRX2",15,0) N DVBAXIEN ;WORKING VARIABLE TO ADD "," TO END OF IEN FOR GETS/GET1 "RTN","DVBAVRX2",16,0) N DVBAVRRA ;DVBA VOCREHAB REQUESTOR EMAIL ADDRESS FROM #200,.151 - EXCHANGE EMAIL ADDRESS "RTN","DVBAVRX2",17,0) N DVBATD ;TODAY "RTN","DVBAVRX2",18,0) N DVBATAG ;TEST AGE "RTN","DVBAVRX2",19,0) N DVBASWSD ;SWITCH FOR DATE (0 OR 1) "RTN","DVBAVRX2",20,0) N DVBAFARY,ERROR ;FORM ARRAY "RTN","DVBAVRX2",21,0) N DATENG ;DATE IN ENGLISH "RTN","DVBAVRX2",22,0) N DVBADOW ;DAY OF WEEK "RTN","DVBAVRX2",23,0) N DVBAAGE,DVBAXAGE "RTN","DVBAVRX2",24,0) N DVBAEMA ;WORKING VARIABLE FOR EMAIL ADDRESS "RTN","DVBAVRX2",25,0) N DVBARPTD ;REPORT FORMAT DATE AND TIME "RTN","DVBAVRX2",26,0) N MAILSUBLN "RTN","DVBAVRX2",27,0) ; "RTN","DVBAVRX2",28,0) S (%H,DAT)=+$H D YMD^%DTC ; CONVERT $H TO FILEMAN DATE "RTN","DVBAVRX2",29,0) S DVBATD=X "RTN","DVBAVRX2",30,0) F DVBAXAGE=5,6,7 D "RTN","DVBAVRX2",31,0) . K DVBAAGE "RTN","DVBAVRX2",32,0) . ;BUILD AGE ARRAY "RTN","DVBAVRX2",33,0) . D WWDA(DVBATD,DVBAXAGE) "RTN","DVBAVRX2",34,0) . S J="" F S J=$O(DVBAAGE(J)) Q:J="" D "RTN","DVBAVRX2",35,0) .. S DVBASWSD=0 "RTN","DVBAVRX2",36,0) .. S DVBADAT=$P(DVBAAGE(J),"^",2)_".0000001" "RTN","DVBAVRX2",37,0) .. F S DVBADAT=$O(^DVB(396.9,"ARSDT","N",DVBADAT)) Q:DVBADAT=""!(DVBASWSD=1) D "RTN","DVBAVRX2",38,0) ... S DVBATAG=$P(DVBADAT,".",1) I DVBATAG'=$P(DVBAAGE(J),"^",2) S DVBASWSD=1 Q "RTN","DVBAVRX2",39,0) ... S DVBAIEN="" F S DVBAIEN=$O(^DVB(396.9,"ARSDT","N",DVBADAT,DVBAIEN)) Q:DVBAIEN="" D "RTN","DVBAVRX2",40,0) .... K DVBAFARY,DVBAFERR "RTN","DVBAVRX2",41,0) .... K DVBAPOC,DVBARDAT,DVBAPNAM,DVBAPDFN,DVBAPSSN,DVBAPSDT,DVBAOK "RTN","DVBAVRX2",42,0) .... S DVBAOK=0 "RTN","DVBAVRX2",43,0) .... D GETS^DIQ(396.9,DVBAIEN_",","*","IE","DVBAFARY","DVBAFERR") "RTN","DVBAVRX2",44,0) .... ; "RTN","DVBAVRX2",45,0) .... S DVBASNTL=$G(DVBAFARY(396.9,DVBAIEN_",",1,"E")) ;SEND TO LOCATION "RTN","DVBAVRX2",46,0) .... S DVBAPOC=$G(DVBAFARY(396.9,DVBAIEN_",",11,"I")) ;POINT OF CONTACT IEN "RTN","DVBAVRX2",47,0) .... S DVBARDAT=$G(DVBAFARY(396.9,DVBAIEN_",",.01,"E")) ;REQUEST DATE "RTN","DVBAVRX2",48,0) .... S DVBAPNAM=$G(DVBAFARY(396.9,DVBAIEN_",",4,"E")) ;PATIENT NAME "RTN","DVBAVRX2",49,0) .... S DVBAPDFN=$G(DVBAFARY(396.9,DVBAIEN_",",4,"I")) ;PATIENT DFN "RTN","DVBAVRX2",50,0) .... ;ICR# FOR #2;.09 - no IA needed for this file "RTN","DVBAVRX2",51,0) .... S DVBAPSDT=DVBAFARY(396.9,DVBAIEN_",",9,"E") ;PREFERRED SCHEDULE DATE [2;3] [D] "RTN","DVBAVRX2",52,0) .... S MAILSUBLN="VOC REHAB REQUEST IS NOW "_DVBAXAGE_" DAYS OLD" "RTN","DVBAVRX2",53,0) .... I DVBAXAGE=5!(DVBAXAGE=6) D "RTN","DVBAVRX2",54,0) ..... S DVBAOK=1 "RTN","DVBAVRX2",55,0) ..... S DVBAEMA="G.DVBA VR VOCREHAB PERSONNEL" "RTN","DVBAVRX2",56,0) ..... D NFYAGE "RTN","DVBAVRX2",57,0) ..... ; "RTN","DVBAVRX2",58,0) .... I DVBAXAGE=7 D "RTN","DVBAVRX2",59,0) ..... ;ICR# (10060) FOR #200;.151 - no IA needed for this file "RTN","DVBAVRX2",60,0) ..... S DVBAXIEN=DVBAIEN_"," "RTN","DVBAVRX2",61,0) ..... S DVBAVRRA=$$GET1^DIQ(200,DVBAFARY(396.9,DVBAXIEN,11,"I"),.151,"","","DVBAGERR") "RTN","DVBAVRX2",62,0) ..... I $D(DVBAGERR) Q "RTN","DVBAVRX2",63,0) ..... Q:DVBAVRRA="" "RTN","DVBAVRX2",64,0) ..... S DVBAEMA=DVBAVRRA "RTN","DVBAVRX2",65,0) ..... D NFYAGE "RTN","DVBAVRX2",66,0) ; "RTN","DVBAVRX2",67,0) Q "RTN","DVBAVRX2",68,0) ; "RTN","DVBAVRX2",69,0) NFYAGE ;SETUP MAILMAN MESSAGE BASED ON JOB1 VARIABLES "RTN","DVBAVRX2",70,0) ; "RTN","DVBAVRX2",71,0) Q:DVBAEMA="" "RTN","DVBAVRX2",72,0) N XMSUB,XMTEXT,XMY,XMDUZ,XMDUN,XMZ,XMMG "RTN","DVBAVRX2",73,0) N DVBAMMT ;MAILMAN MESSAGE TEXT ARRAY "RTN","DVBAVRX2",74,0) N DVBASTT ;START TIME STAMP "RTN","DVBAVRX2",75,0) N C,D,D0,DA,DI,DIC,DIE,DILOCKTM,DISYS,DQ,DR,X,Y,% "RTN","DVBAVRX2",76,0) ; "RTN","DVBAVRX2",77,0) S %H=$H D YX^%DTC S X=X_% S DVBASTT=$$FMTE^XLFDT(X,"5FPZ") "RTN","DVBAVRX2",78,0) S XMDUZ="VOCREHAB POSTMASTER" "RTN","DVBAVRX2",79,0) S XMSUB="Chapter 31 Referral for Medical Services has aged "_DVBAXAGE_" days" "RTN","DVBAVRX2",80,0) S XMY(DVBAEMA)="" "RTN","DVBAVRX2",81,0) S XMTEXT="DVBAMMT(" "RTN","DVBAVRX2",82,0) S DVBAMMT(1)="Sent: "_DVBASTT "RTN","DVBAVRX2",83,0) S DVBAMMT(2)="To: "_DVBAEMA "RTN","DVBAVRX2",84,0) S DVBAMMT(3)="Subject: "_XMSUB "RTN","DVBAVRX2",85,0) S DVBAMMT(4)="" "RTN","DVBAVRX2",86,0) S DVBAMMT(5)=" REQUEST DATE: "_DVBARDAT "RTN","DVBAVRX2",87,0) S DVBAMMT(6)=" PATIENT DFN: `"_DVBAPDFN "RTN","DVBAVRX2",88,0) S DVBAMMT(7)=" PREFERRED SCHEDULE DATE: "_DVBAPSDT "RTN","DVBAVRX2",89,0) S DVBAMMT(7.5)="" "RTN","DVBAVRX2",90,0) S DVBAMMT(8)="THE 'NEW' STATUS ON THIS FORM 28-8861 HAS NOW AGED "_DVBAXAGE_" DAYS" "RTN","DVBAVRX2",91,0) S DVBAMMT(9)="PLEASE MAKE SURE PATIENT HAS CONSULT LINKED TO FORM." "RTN","DVBAVRX2",92,0) S DVBAMMT(10)="" "RTN","DVBAVRX2",93,0) S DVBAMMT(11)="**NOTE: To view the patient using the DFN, paste the DFN number into the" "RTN","DVBAVRX2",94,0) S DVBAMMT(12)="CAPRI Patient Selector 'Patient ID' field to find the patient. Be sure to" "RTN","DVBAVRX2",95,0) S DVBAMMT(13)="include the ' (backward-apostrophe) character." "RTN","DVBAVRX2",96,0) ; "RTN","DVBAVRX2",97,0) D XMZ^XMA2 "RTN","DVBAVRX2",98,0) D ^XMD "RTN","DVBAVRX2",99,0) ; "RTN","DVBAVRX2",100,0) Q "RTN","DVBAVRX2",101,0) ; "RTN","DVBAVRX2",102,0) WWDA(DVBATD,DVBAXAGE) "RTN","DVBAVRX2",103,0) ; "RTN","DVBAVRX2",104,0) ;WORK WEEK DAY AGING "RTN","DVBAVRX2",105,0) ; RETURNS THE DATES TO WRITE EMAILS FOR "RTN","DVBAVRX2",106,0) ; DVBATD TODAY IS THE DATE THE FUNCTION IS RUNNING FOR "RTN","DVBAVRX2",107,0) ; DVBAAGE AGE IS THE NUMBER OF DAYS TO AGE FOR (5, 6, OR 7) ONLY "RTN","DVBAVRX2",108,0) ; SPECIAL DAYS OF THE WEEK ARE MON, FRIDAY, AND TUESDAY "RTN","DVBAVRX2",109,0) ; "RTN","DVBAVRX2",110,0) ;IS DAT A WEEKEND DAY? "RTN","DVBAVRX2",111,0) ; "RTN","DVBAVRX2",112,0) ;S DVBAAGE(5)="" ; MON=MON, TUE=TUE, ... "RTN","DVBAVRX2",113,0) ; ; FRIDAY LOOKS FOR ALL SAT AND SUN FORM 8861 ENTRIES 5 DAYS OLD "RTN","DVBAVRX2",114,0) ;S DVBAAGE(6)="" ; MON=FRI, TUE=MON, WED=TUE, THR=WED, FRI=THR "RTN","DVBAVRX2",115,0) ; ; MONDAY LOOKS FOR ALL SAT AND SUN FORM 8861 ENTRIES 6 DAYS OLD "RTN","DVBAVRX2",116,0) ;S DVBAAGE(7)="" ; MON=THR, TUE=FRI, WED=MON, THR=TUE, FRI=WED "RTN","DVBAVRX2",117,0) ; ; TUESDAY LOOKS FOR ALL SAT AND SUN FORM 8861 ENTRIES 7 DAYS OLD "RTN","DVBAVRX2",118,0) ; "RTN","DVBAVRX2",119,0) N %Y,X,X1,X2 "RTN","DVBAVRX2",120,0) N J,DVBADOW "RTN","DVBAVRX2",121,0) K DVBAAGE "RTN","DVBAVRX2",122,0) ; "RTN","DVBAVRX2",123,0) S X=DVBATD "RTN","DVBAVRX2",124,0) ;RETURN TODAY'S DAY OF THE WEEK (0-6)/(SUN - SAT) "RTN","DVBAVRX2",125,0) D DW^%DTC "RTN","DVBAVRX2",126,0) S DVBADOW=%Y "RTN","DVBAVRX2",127,0) ; "RTN","DVBAVRX2",128,0) ;DO NOT RUN ON DOW 0 OR 6 "RTN","DVBAVRX2",129,0) I DVBADOW=0!(DVBADOW=6) Q "" "RTN","DVBAVRX2",130,0) ; "RTN","DVBAVRX2",131,0) I DVBADOW=1&(DVBAXAGE=5) S DVBAAGE("MON")=-7 "RTN","DVBAVRX2",132,0) I DVBADOW=1&(DVBAXAGE=6) S DVBAAGE("FRI")=-10 "RTN","DVBAVRX2",133,0) I DVBADOW=1&(DVBAXAGE=6) S DVBAAGE("SAT")=-9 "RTN","DVBAVRX2",134,0) I DVBADOW=1&(DVBAXAGE=6) S DVBAAGE("SUN")=-8 "RTN","DVBAVRX2",135,0) I DVBADOW=1&(DVBAXAGE=7) S DVBAAGE("THR")=-11 "RTN","DVBAVRX2",136,0) ; "RTN","DVBAVRX2",137,0) I DVBADOW=2&(DVBAXAGE=5) S DVBAAGE("TUE")=-7 "RTN","DVBAVRX2",138,0) I DVBADOW=2&(DVBAXAGE=6) S DVBAAGE("MON")=-8 "RTN","DVBAVRX2",139,0) I DVBADOW=2&(DVBAXAGE=7) S DVBAAGE("FRI")=-11 "RTN","DVBAVRX2",140,0) I DVBADOW=2&(DVBAXAGE=7) S DVBAAGE("SAT")=-10 "RTN","DVBAVRX2",141,0) I DVBADOW=2&(DVBAXAGE=7) S DVBAAGE("SUN")=-9 "RTN","DVBAVRX2",142,0) ; "RTN","DVBAVRX2",143,0) I DVBADOW=3&(DVBAXAGE=5) S DVBAAGE("WED")=-7 "RTN","DVBAVRX2",144,0) I DVBADOW=3&(DVBAXAGE=6) S DVBAAGE("TUE")=-8 "RTN","DVBAVRX2",145,0) I DVBADOW=3&(DVBAXAGE=7) S DVBAAGE("MON")=-9 "RTN","DVBAVRX2",146,0) ; "RTN","DVBAVRX2",147,0) I DVBADOW=4&(DVBAXAGE=5) S DVBAAGE("THR")=-7 "RTN","DVBAVRX2",148,0) I DVBADOW=4&(DVBAXAGE=6) S DVBAAGE("WED")=-8 "RTN","DVBAVRX2",149,0) I DVBADOW=4&(DVBAXAGE=7) S DVBAAGE("TUE")=-9 "RTN","DVBAVRX2",150,0) ; "RTN","DVBAVRX2",151,0) I DVBADOW=5&(DVBAXAGE=5) S DVBAAGE("FRI")=-7 "RTN","DVBAVRX2",152,0) I DVBADOW=5&(DVBAXAGE=5) S DVBAAGE("SAT")=-6 "RTN","DVBAVRX2",153,0) I DVBADOW=5&(DVBAXAGE=5) S DVBAAGE("SUN")=-5 "RTN","DVBAVRX2",154,0) I DVBADOW=5&(DVBAXAGE=6) S DVBAAGE("THR")=-8 "RTN","DVBAVRX2",155,0) I DVBADOW=5&(DVBAXAGE=7) S DVBAAGE("WED")=-9 "RTN","DVBAVRX2",156,0) ; "RTN","DVBAVRX2",157,0) S J="" F S J=$O(DVBAAGE(J)) Q:J="" D "RTN","DVBAVRX2",158,0) . S X1=DVBATD "RTN","DVBAVRX2",159,0) . S X2=DVBAAGE(J) "RTN","DVBAVRX2",160,0) . D C^%DTC "RTN","DVBAVRX2",161,0) . S $P(DVBAAGE(J),"^",2)=X "RTN","DVBAVRX2",162,0) ; "RTN","DVBAVRX2",163,0) Q "RTN","DVBAVRX2",164,0) ; "SEC","^DIC",396.9,396.9,0,"AUDIT") @ "SEC","^DIC",396.9,396.9,0,"DD") @ "SEC","^DIC",396.9,396.9,0,"DEL") @ "SEC","^DIC",396.9,396.9,0,"LAYGO") @ "SEC","^DIC",396.9,396.9,0,"RD") @ "SEC","^DIC",396.9,396.9,0,"WR") @ "SEC","^DIC",396.918,396.918,0,"AUDIT") @ "SEC","^DIC",396.918,396.918,0,"DD") @ "SEC","^DIC",396.918,396.918,0,"DEL") @ "SEC","^DIC",396.918,396.918,0,"LAYGO") @ "SEC","^DIC",396.918,396.918,0,"RD") @ "SEC","^DIC",396.918,396.918,0,"WR") @ "VER") 8.0^22.0 "^DD",396.9,396.9,0) FIELD^^14^19 "^DD",396.9,396.9,0,"DDA") N "^DD",396.9,396.9,0,"DT") 3120807 "^DD",396.9,396.9,0,"IX","B",396.9,.01) "^DD",396.9,396.9,0,"IX","C",396.9,4) "^DD",396.9,396.9,0,"NM","FORM 28-8861") "^DD",396.9,396.9,.01,0) REQUEST DATE^D^^0;1^S %DT="ETXR" D ^%DT S X=Y K:Y<1 X "^DD",396.9,396.9,.01,1,0) ^.1 "^DD",396.9,396.9,.01,1,1,0) 396.9^B "^DD",396.9,396.9,.01,1,1,1) S ^DVB(396.9,"B",$E(X,1,30),DA)="" "^DD",396.9,396.9,.01,1,1,2) K ^DVB(396.9,"B",$E(X,1,30),DA) "^DD",396.9,396.9,.01,3) Enter the date of the request. "^DD",396.9,396.9,.01,21,0) ^.001^1^1^3120530^^^^ "^DD",396.9,396.9,.01,21,1,0) Date of 8861 Request for Medical Services, Chapter 31. The request date defaults to the current date. "^DD",396.9,396.9,.01,"DT") 3120606 "^DD",396.9,396.9,1,0) ROUTING LOCATION^RP40.8'^DG(40.8,^0;2^Q "^DD",396.9,396.9,1,3) Enter routing location where Form 8861 request should be sent to. "^DD",396.9,396.9,1,21,0) ^.001^1^1^3120807^^ "^DD",396.9,396.9,1,21,1,0) This is the VHA facility that will provide medical services for the veteran. "^DD",396.9,396.9,1,"DT") 3120807 "^DD",396.9,396.9,2,0) COMPLETION DATE^D^^0;3^S %DT="EX" D ^%DT S X=Y K:Y<1 X "^DD",396.9,396.9,2,3) Select the date the request was completed. "^DD",396.9,396.9,2,21,0) ^^1^1^3120601^ "^DD",396.9,396.9,2,21,1,0) This is the date the requested was completed. The value will be supplied by the system. "^DD",396.9,396.9,2,"DT") 3120601 "^DD",396.9,396.9,3,0) REGIONAL OFFICE^RP4'^DIC(4,^0;4^Q "^DD",396.9,396.9,3,3) Select the Regional Office of the requestor. "^DD",396.9,396.9,3,21,0) ^.001^1^1^3120702^^^ "^DD",396.9,396.9,3,21,1,0) This is the Regional Office of the user that submits the 8861 request. This value is entered by the system. "^DD",396.9,396.9,3,"DT") 3120702 "^DD",396.9,396.9,4,0) PATIENT^P2'^DPT(^0;5^Q "^DD",396.9,396.9,4,1,0) ^.1 "^DD",396.9,396.9,4,1,2,0) 396.9^C "^DD",396.9,396.9,4,1,2,1) S ^DVB(396.9,"C",$E(X,1,30),DA)="" "^DD",396.9,396.9,4,1,2,2) K ^DVB(396.9,"C",$E(X,1,30),DA) "^DD",396.9,396.9,4,1,2,"%D",0) ^.101^1^1^3120413^^^ "^DD",396.9,396.9,4,1,2,"%D",1,0) This cross-reference will be used to sort 8861 Request records by patient name. "^DD",396.9,396.9,4,1,2,"DT") 3120412 "^DD",396.9,396.9,4,3) Select the patient. "^DD",396.9,396.9,4,21,0) ^.001^1^1^3120524^^ "^DD",396.9,396.9,4,21,1,0) This is the veteran to whom the request pertains. "^DD",396.9,396.9,4,"DT") 3120412 "^DD",396.9,396.9,5,0) REHAB OBJECTIVE OF VETERAN^RF^^1;1^K:$L(X)>245!($L(X)<1) X "^DD",396.9,396.9,5,3) Answer must be 1-245 characters in length. "^DD",396.9,396.9,5,21,0) ^^1^1^3120405^ "^DD",396.9,396.9,5,21,1,0) The Rehabilitation Objective of Veteran states what the veteran hopes to achieve through rehabilitation. "^DD",396.9,396.9,5,"DT") 3120405 "^DD",396.9,396.9,6,0) REASON FOR REFERRAL^RF^^2;1^K:$L(X)>75!($L(X)<1) X "^DD",396.9,396.9,6,3) Answer must be 1-75 characters in length. "^DD",396.9,396.9,6,21,0) ^.001^1^1^3120511^^^ "^DD",396.9,396.9,6,21,1,0) Describe the reason for referral. "^DD",396.9,396.9,6,"DT") 3120511 "^DD",396.9,396.9,7,0) ANTICIPATED DATE OF REHAB^RD^^0;6^S %DT="EX" D ^%DT S X=Y K:Y<1 X "^DD",396.9,396.9,7,3) Enter Anticipated Date of Rehabilitation. "^DD",396.9,396.9,7,21,0) ^.001^1^1^3120511^^ "^DD",396.9,396.9,7,21,1,0) This is the date the veteran is expected to achieve rehabilitation. "^DD",396.9,396.9,7,"DT") 3120511 "^DD",396.9,396.9,8,0) MEDICAL SERVICES REQUESTED^RP396.918'^DVB(396.918,^2;2^Q "^DD",396.9,396.9,8,3) Select a medical service for this request. "^DD",396.9,396.9,8,21,0) ^.001^1^1^3120614^^^^ "^DD",396.9,396.9,8,21,1,0) This is the medical service requested as the type of exam being requested. Only one item can be selected. "^DD",396.9,396.9,8,"DT") 3120614 "^DD",396.9,396.9,8.1,0) OTHER REASON^F^^6;1^K:$L(X)>50!($L(X)<1) X "^DD",396.9,396.9,8.1,3) Answer must be 1-50 characters in length. Enter Other Reason for Referral if value is not on list of Medical Services Requested in previous prompt. "^DD",396.9,396.9,8.1,21,0) ^.001^1^1^3120618^^^^ "^DD",396.9,396.9,8.1,21,1,0) This field will be used if the Medical Service Requested is not in the list provided and you choose "Other" for Medical Services Requested (previous prompt). "^DD",396.9,396.9,8.1,"DT") 3120405 "^DD",396.9,396.9,9,0) PREFERRED SCHEDULE DATE^D^^2;3^S %DT="EX" D ^%DT S X=Y K:Y<1 X "^DD",396.9,396.9,9,3) Enter the date the veteran needs to be seen by only when a Preferred Schedule Date Reason is entered also. "^DD",396.9,396.9,9,21,0) ^.001^1^1^3120511^^^ "^DD",396.9,396.9,9,21,1,0) This is the date the veteran needs to be seen by. "^DD",396.9,396.9,9,"DT") 3120511 "^DD",396.9,396.9,10,0) PREFERRED SCHED DATE REASON^F^^2;4^K:$L(X)>50!($L(X)<1) X "^DD",396.9,396.9,10,3) Answer must be 1-50 characters in length. Only required when a Preferred Schedule Date is entered. "^DD",396.9,396.9,10,21,0) ^.001^1^1^3120511^^ "^DD",396.9,396.9,10,21,1,0) Used to describe why the veteran needs to be seen by the entered Preferred Schedule Date. "^DD",396.9,396.9,10,"DT") 3120511 "^DD",396.9,396.9,11,0) POINT OF CONTACT^P200'^VA(200,^2;5^Q "^DD",396.9,396.9,11,3) Select the Point of Contact user. "^DD",396.9,396.9,11,21,0) ^.001^1^1^3120531^^^^ "^DD",396.9,396.9,11,21,1,0) The Point of Contact is the same as the person that submits Form 8861. The POC is printed on the Status Report and would be contacted with any questions about the request. "^DD",396.9,396.9,11,"DT") 3120405 "^DD",396.9,396.9,12,0) COMMENTS/NOTES^396.912^^3;0 "^DD",396.9,396.9,13,0) REQUEST STATUS^RS^N:NEW;P:PENDING;X:CANCELLED;C:COMPLETE;A:ALL;^4;1^Q "^DD",396.9,396.9,13,1,0) ^.1^^0 "^DD",396.9,396.9,13,3) Enter the status of the request. "^DD",396.9,396.9,13,21,0) ^.001^1^1^3120614^^^^ "^DD",396.9,396.9,13,21,1,0) This is the status of the 8861 Request. "A" for "ALL" is only for choosing a status for the Status Report. "^DD",396.9,396.9,13,"DT") 3120614 "^DD",396.9,396.9,14,0) CONSULTS^396.914PA^^5;0 "^DD",396.9,396.9,14,21,0) ^.001^1^1^3120614^^ "^DD",396.9,396.9,14,21,1,0) This field associates the request with a record in the Request/Consultation file. "^DD",396.9,396.9,15,0) CANCELLATION DATE^D^^4;2^S %DT="EX" D ^%DT S X=Y K:Y<1 X "^DD",396.9,396.9,15,3) Enter the date the request is cancelled. "^DD",396.9,396.9,15,21,0) ^.001^1^1^3120614^^^ "^DD",396.9,396.9,15,21,1,0) This is the date that the request is cancelled. "^DD",396.9,396.9,15,"DT") 3120614 "^DD",396.9,396.9,16,0) CANCELLATION REASON^S^DUP:DUPLICATE MEDICAL REQUEST;VET:VETERAN WITHDREW MEDICAL REQUEST FOR SERVICES;ADQ:ADEQUATE MEDICAL EVIDENCE RECEIVED;DIED:VETERAN DIED;OTH:OTHER;^4;3^Q "^DD",396.9,396.9,16,3) Select the reason the request was cancelled. "^DD",396.9,396.9,16,21,0) ^.001^1^1^3120614^^^^ "^DD",396.9,396.9,16,21,1,0) This is the reason the request was cancelled. "^DD",396.9,396.9,16,"DT") 3120614 "^DD",396.9,396.9,17,0) ADDITIONAL REMARKS^F^^4;4^K:$L(X)>50!($L(X)<3) X "^DD",396.9,396.9,17,3) Answer must be 3-50 characters in length. Provide additional information about the reason for the cancellation. "^DD",396.9,396.9,17,21,0) ^.001^1^1^3120614^^^^ "^DD",396.9,396.9,17,21,1,0) This is additional information for the cancelled request. "^DD",396.9,396.9,17,"DT") 3120601 "^DD",396.9,396.912,0) COMMENTS/NOTES SUB-FIELD^^.01^1 "^DD",396.9,396.912,0,"DT") 3120405 "^DD",396.9,396.912,0,"NM","COMMENTS/NOTES") "^DD",396.9,396.912,0,"UP") 396.9 "^DD",396.9,396.912,.01,0) COMMENTS/NOTES^Wx^^0;1^Q "^DD",396.9,396.912,.01,3) Enter any comments or notes regarding this request. "^DD",396.9,396.912,.01,21,0) ^^1^1^3120405^ "^DD",396.9,396.912,.01,21,1,0) This field is used for communications between the VHA and Vocational Rehab POC. "^DD",396.9,396.912,.01,"DT") 3120405 "^DD",396.9,396.914,0) CONSULTS SUB-FIELD^^.02^2 "^DD",396.9,396.914,0,"DT") 3120606 "^DD",396.9,396.914,0,"IX","B",396.914,.01) "^DD",396.9,396.914,0,"NM","CONSULTS") "^DD",396.9,396.914,0,"UP") 396.9 "^DD",396.9,396.914,.01,0) CONSULT^P123'^GMR(123,^0;1^Q "^DD",396.9,396.914,.01,1,0) ^.1 "^DD",396.9,396.914,.01,1,1,0) 396.914^B "^DD",396.9,396.914,.01,1,1,1) S ^DVB(396.9,DA(1),5,"B",$E(X,1,30),DA)="" "^DD",396.9,396.914,.01,1,1,2) K ^DVB(396.9,DA(1),5,"B",$E(X,1,30),DA) "^DD",396.9,396.914,.01,3) Select a consult to associate with the request. "^DD",396.9,396.914,.01,21,0) ^.001^1^1^3120606^^ "^DD",396.9,396.914,.01,21,1,0) This field associates the request with a record or records in the Request/Consultation file. "^DD",396.9,396.914,.01,"DT") 3120606 "^DD",396.9,396.914,.02,0) LAST STATUS^P100.01'^ORD(100.01,^5;1^Q "^DD",396.9,396.914,.02,3) The system stores the last known status of the consult here. "^DD",396.9,396.914,.02,21,0) ^.001^1^1^3120614^^^ "^DD",396.9,396.914,.02,21,1,0) When the status of the consult changes in file #123, field #8, the new status is stored here. "^DD",396.9,396.914,.02,"DT") 3120606 "^DD",396.918,396.918,0) FIELD^^.01^1 "^DD",396.918,396.918,0,"DT") 3120621 "^DD",396.918,396.918,0,"IX","B",396.918,.01) "^DD",396.918,396.918,0,"NM","MEDICAL SERVICES REQUESTED") "^DD",396.918,396.918,.01,0) NAME^RF^^0;1^K:$L(X)>75!($L(X)<3)!'(X'?1P.E) X "^DD",396.918,396.918,.01,1,0) ^.1 "^DD",396.918,396.918,.01,1,1,0) 396.918^B "^DD",396.918,396.918,.01,1,1,1) S ^DVB(396.918,"B",$E(X,1,30),DA)="" "^DD",396.918,396.918,.01,1,1,2) K ^DVB(396.918,"B",$E(X,1,30),DA) "^DD",396.918,396.918,.01,3) Answer must be 3-75 characters in length. Enter a medical service which may be requested. "^DD",396.918,396.918,.01,21,0) ^^1^1^3120621^ "^DD",396.918,396.918,.01,21,1,0) This is a name of a medical service which may be requested through Form 28-8861. "^DD",396.918,396.918,.01,"DT") 3120621 "^DIC",396.9,396.9,0) FORM 28-8861^396.9 "^DIC",396.9,396.9,0,"GL") ^DVB(396.9, "^DIC",396.9,396.9,"%D",0) ^^1^1^3120524^ "^DIC",396.9,396.9,"%D",1,0) The FORM 28-8861 file contains data from veteran's Chapter 31 Request for Medical Services requests. The 8861 requests are tied to consults created through CPRS. "^DIC",396.9,"B","FORM 28-8861",396.9) "^DIC",396.918,396.918,0) MEDICAL SERVICES REQUESTED^396.918 "^DIC",396.918,396.918,0,"GL") ^DVB(396.918, "^DIC",396.918,"B","MEDICAL SERVICES REQUESTED",396.918) "BLD",8365,6) ^160 **END** **END**