Released DVBA*2.7*187 SEQ #165 Extracted from mail message **KIDS**:DVBA*2.7*187^ **INSTALL NAME** DVBA*2.7*187 "BLD",8596,0) DVBA*2.7*187^AUTOMATED MED INFO EXCHANGE^0^3141215^y "BLD",8596,1,0) ^^1^1^3141212^^ "BLD",8596,1,1,0) VLER DAS BUILD 2 - REFER TO PATCH DESCRIPTION FOR MORE INFORMATION. "BLD",8596,4,0) ^9.64PA^396.3^2 "BLD",8596,4,396.3,0) 396.3 "BLD",8596,4,396.3,2,0) ^9.641^396.3^1 "BLD",8596,4,396.3,2,396.3,0) 2507 REQUEST (File-top level) "BLD",8596,4,396.3,2,396.3,1,0) ^9.6411^46^1 "BLD",8596,4,396.3,2,396.3,1,46,0) REQUEST UUID "BLD",8596,4,396.3,222) y^y^p^^^^n^^n "BLD",8596,4,396.3,224) "BLD",8596,4,396.45,0) 396.45 "BLD",8596,4,396.45,2,0) ^9.641^396.45^1 "BLD",8596,4,396.45,2,396.45,0) 2507 EXAM CONTRACTORS (File-top level) "BLD",8596,4,396.45,2,396.45,1,0) ^9.6411^105^1 "BLD",8596,4,396.45,2,396.45,1,105,0) VLER ENABLED "BLD",8596,4,396.45,222) y^y^p^^^^n^^n "BLD",8596,4,396.45,224) "BLD",8596,4,"APDD",396.3,396.3) "BLD",8596,4,"APDD",396.3,396.3,46) "BLD",8596,4,"APDD",396.45,396.45) "BLD",8596,4,"APDD",396.45,396.45,105) "BLD",8596,4,"B",396.3,396.3) "BLD",8596,4,"B",396.45,396.45) "BLD",8596,6.3) 13 "BLD",8596,"ABPKG") n "BLD",8596,"INID") ^n "BLD",8596,"INIT") ENTER^DVBA187P "BLD",8596,"KRN",0) ^9.67PA^779.2^20 "BLD",8596,"KRN",.4,0) .4 "BLD",8596,"KRN",.401,0) .401 "BLD",8596,"KRN",.402,0) .402 "BLD",8596,"KRN",.403,0) .403 "BLD",8596,"KRN",.5,0) .5 "BLD",8596,"KRN",.84,0) .84 "BLD",8596,"KRN",3.6,0) 3.6 "BLD",8596,"KRN",3.8,0) 3.8 "BLD",8596,"KRN",9.2,0) 9.2 "BLD",8596,"KRN",9.8,0) 9.8 "BLD",8596,"KRN",9.8,"NM",0) ^9.68A^2^1 "BLD",8596,"KRN",9.8,"NM",2,0) DVBAB1A^^0^B29208076 "BLD",8596,"KRN",9.8,"NM","B","DVBAB1A",2) "BLD",8596,"KRN",19,0) 19 "BLD",8596,"KRN",19,"NM",0) ^9.68A^^0 "BLD",8596,"KRN",19.1,0) 19.1 "BLD",8596,"KRN",19.1,"NM",0) ^9.68A^3^2 "BLD",8596,"KRN",19.1,"NM",2,0) DVBA CAPRI GETVBADOCS^^0 "BLD",8596,"KRN",19.1,"NM",3,0) DVBA CAPRI GETDOCSFROMVLER^^0 "BLD",8596,"KRN",19.1,"NM","B","DVBA CAPRI GETDOCSFROMVLER",3) "BLD",8596,"KRN",19.1,"NM","B","DVBA CAPRI GETVBADOCS",2) "BLD",8596,"KRN",101,0) 101 "BLD",8596,"KRN",409.61,0) 409.61 "BLD",8596,"KRN",771,0) 771 "BLD",8596,"KRN",779.2,0) 779.2 "BLD",8596,"KRN",870,0) 870 "BLD",8596,"KRN",8989.51,0) 8989.51 "BLD",8596,"KRN",8989.52,0) 8989.52 "BLD",8596,"KRN",8994,0) 8994 "BLD",8596,"KRN",8994,"NM",0) ^9.68A^^0 "BLD",8596,"KRN","B",.4,.4) "BLD",8596,"KRN","B",.401,.401) "BLD",8596,"KRN","B",.402,.402) "BLD",8596,"KRN","B",.403,.403) "BLD",8596,"KRN","B",.5,.5) "BLD",8596,"KRN","B",.84,.84) "BLD",8596,"KRN","B",3.6,3.6) "BLD",8596,"KRN","B",3.8,3.8) "BLD",8596,"KRN","B",9.2,9.2) "BLD",8596,"KRN","B",9.8,9.8) "BLD",8596,"KRN","B",19,19) "BLD",8596,"KRN","B",19.1,19.1) "BLD",8596,"KRN","B",101,101) "BLD",8596,"KRN","B",409.61,409.61) "BLD",8596,"KRN","B",771,771) "BLD",8596,"KRN","B",779.2,779.2) "BLD",8596,"KRN","B",870,870) "BLD",8596,"KRN","B",8989.51,8989.51) "BLD",8596,"KRN","B",8989.52,8989.52) "BLD",8596,"KRN","B",8994,8994) "BLD",8596,"QUES",0) ^9.62^^ "BLD",8596,"REQB",0) ^9.611^1^1 "BLD",8596,"REQB",1,0) DVBA*2.7*185^2 "BLD",8596,"REQB","B","DVBA*2.7*185",1) "FIA",396.3) 2507 REQUEST "FIA",396.3,0) ^DVB(396.3, "FIA",396.3,0,0) 396.3IP "FIA",396.3,0,1) y^y^p^^^^n^^n "FIA",396.3,0,10) "FIA",396.3,0,11) "FIA",396.3,0,"RLRO") "FIA",396.3,0,"VR") 2.7^DVBA "FIA",396.3,396.3) 1 "FIA",396.3,396.3,46) "FIA",396.45) 2507 EXAM CONTRACTORS "FIA",396.45,0) ^DVB(396.45, "FIA",396.45,0,0) 396.45 "FIA",396.45,0,1) y^y^p^^^^n^^n "FIA",396.45,0,10) "FIA",396.45,0,11) "FIA",396.45,0,"RLRO") "FIA",396.45,0,"VR") 2.7^DVBA "FIA",396.45,396.45) 1 "FIA",396.45,396.45,105) "INIT") ENTER^DVBA187P "KRN",19.1,609,-1) 0^2 "KRN",19.1,609,0) DVBA CAPRI GETVBADOCS^VIEW GET DOCS FROM VIRTUAL VA^l^y "KRN",19.1,609,1,0) ^^2^2^3140724^ "KRN",19.1,609,1,1,0) DVBA CAPRI GETVBADOCS is a security key for CAPRI users to view "KRN",19.1,609,1,2,0) the "Get Docs from Virtual VA" option in CAPRI "KRN",19.1,611,-1) 0^3 "KRN",19.1,611,0) DVBA CAPRI GETDOCSFROMVLER^Get VLER DAS documents^l^y "KRN",19.1,611,1,0) ^^2^2^3141215^ "KRN",19.1,611,1,1,0) The key will allow users to run queries from VLER DAS provided the "KRN",19.1,611,1,2,0) necessary training has been completed by DMA. "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 "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) 187^3141215 "PKG",223,22,1,"PAH",1,1,0) ^^1^1^3141215 "PKG",223,22,1,"PAH",1,1,1,0) VLER DAS BUILD 2 - REFER TO PATCH DESCRIPTION FOR MORE INFORMATION. "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") 2 "RTN","DVBA187P") 0^^B80895477^n/a "RTN","DVBA187P",1,0) DVBA187P ;ALB/GAK - PATCH DVBA*2.7*187 POST-INSTALL ROUTINE;08-OCT-2013 "RTN","DVBA187P",2,0) ;;2.7;AMIE;**187**;Apr 10, 1995;Build 13 "RTN","DVBA187P",3,0) Q "RTN","DVBA187P",4,0) ; "RTN","DVBA187P",5,0) ENTER ; "RTN","DVBA187P",6,0) D AMIE "RTN","DVBA187P",7,0) D SECKEY "RTN","DVBA187P",8,0) Q "RTN","DVBA187P",9,0) ; "RTN","DVBA187P",10,0) ; "RTN","DVBA187P",11,0) AMIE ;Update for the AMIE EXAM (#396.6) file "RTN","DVBA187P",12,0) ; "RTN","DVBA187P",13,0) ;Used to inactivate old entries and/or create new entries for designated worksheet updates "RTN","DVBA187P",14,0) ; "RTN","DVBA187P",15,0) D BMES^XPDUTL(" Update to AMIE EXAM (#396.6) file...") "RTN","DVBA187P",16,0) I '$D(^DVB(396.6)) D BMES^XPDUTL("Missing AMIE EXAM (#396.6) file") Q "RTN","DVBA187P",17,0) I $D(^DVB(396.6)) D "RTN","DVBA187P",18,0) . ;Add new SHA entry to AMIE EXAM file "RTN","DVBA187P",19,0) . D NEW "RTN","DVBA187P",20,0) . ;Rename existing Medical Opinion 1 entry in AMIE EXAM file "RTN","DVBA187P",21,0) . D RENAMIE "RTN","DVBA187P",22,0) . ;Inactivate existing entires in AMIE EXAM file "RTN","DVBA187P",23,0) . D INACAMIE "RTN","DVBA187P",24,0) . ; Rename Medical Opinion PRINT NAME field "RTN","DVBA187P",25,0) . D RENMEDOP "RTN","DVBA187P",26,0) Q "RTN","DVBA187P",27,0) ; "RTN","DVBA187P",28,0) ; "RTN","DVBA187P",29,0) NEW ;Add new exam entry "RTN","DVBA187P",30,0) ; "RTN","DVBA187P",31,0) N DVBAI,DVBLINE,DVBIEN,DVBEXM,DVBPNM,DVBBDY,DVBROU,DVBSTAT,DVBWKS "RTN","DVBA187P",32,0) ; "RTN","DVBA187P",33,0) D BMES^XPDUTL(" Adding new AMIE EXAM (#396.6) file entry...") "RTN","DVBA187P",34,0) F DVBAI=1:1 S DVBLINE=$P($T(AMIENEW+DVBAI),";;",2) Q:DVBLINE="QUIT" D "RTN","DVBA187P",35,0) . N DVBAMSG "RTN","DVBA187P",36,0) . S DVBIEN=$P(DVBLINE,";",1) ;ien "RTN","DVBA187P",37,0) . S DVBEXM=$P(DVBLINE,";",2) ;exam name "RTN","DVBA187P",38,0) . S DVBPNM=$P(DVBLINE,";",3) ;print name "RTN","DVBA187P",39,0) . S DVBBDY=$P(DVBLINE,";",4) ;body system "RTN","DVBA187P",40,0) . S DVBROU=$P(DVBLINE,";",5) ;routine name "RTN","DVBA187P",41,0) . S DVBSTAT=$P(DVBLINE,";",6) ;status "RTN","DVBA187P",42,0) . S DVBWKS=$P(DVBLINE,";",8) ;worksheet number "RTN","DVBA187P",43,0) . D BMES^XPDUTL(" Attempting to add Entry #"_DVBIEN_"...") "RTN","DVBA187P",44,0) . D NEWEXAM^DVBAUTLP(DVBIEN,DVBEXM,DVBPNM,DVBBDY,DVBROU,DVBSTAT,DVBWKS,.DVBAMSG) "RTN","DVBA187P",45,0) . ; Display status message returned if any "RTN","DVBA187P",46,0) . D:$D(DVBAMSG)>0 MES^XPDUTL(.DVBAMSG) "RTN","DVBA187P",47,0) . D BMES^XPDUTL(" Completed adding new AMIE EXAM (#396.6) file entry...") "RTN","DVBA187P",48,0) Q "RTN","DVBA187P",49,0) ; "RTN","DVBA187P",50,0) RENAMIE ;Rename existing DBQ exam file entries "RTN","DVBA187P",51,0) ; "RTN","DVBA187P",52,0) N DVBAI,DVBLINE,DVBIEN,DVBEXMO,DVBEXMN "RTN","DVBA187P",53,0) ; "RTN","DVBA187P",54,0) D BMES^XPDUTL("Renaming AMIE EXAM (#396.6) file entries...") "RTN","DVBA187P",55,0) F DVBAI=1:1 S DVBLINE=$P($T(EXOLDNEW+DVBAI),";;",2) Q:DVBLINE="QUIT" D "RTN","DVBA187P",56,0) . S DVBIEN=$P(DVBLINE,";",1) ;ien "RTN","DVBA187P",57,0) . S DVBEXMO=$P(DVBLINE,";",2) ;old exam name "RTN","DVBA187P",58,0) . S DVBEXMN=$P(DVBLINE,";",3) ;new exam name "RTN","DVBA187P",59,0) . D RENEXAM "RTN","DVBA187P",60,0) D BMES^XPDUTL("Completed Renaming AMIE EXAM (#396.6) file entries...") "RTN","DVBA187P",61,0) K DVBEXMO,DVBEXMN "RTN","DVBA187P",62,0) Q "RTN","DVBA187P",63,0) ; "RTN","DVBA187P",64,0) RENEXAM ; "RTN","DVBA187P",65,0) ;Quit if critical variables missing. For each EXOLDNEW entry, do this. "RTN","DVBA187P",66,0) I $G(DVBIEN)'>0!($G(DVBEXMO)']"")!($G(DVBEXMN)']"") D Q "RTN","DVBA187P",67,0) . D BMES^XPDUTL("Insufficient data to process change at #"_DVBIEN_")") "RTN","DVBA187P",68,0) ; "RTN","DVBA187P",69,0) ; Update existing entry "RTN","DVBA187P",70,0) ; "RTN","DVBA187P",71,0) N DVBAERR,DVBAFDA "RTN","DVBA187P",72,0) ; "RTN","DVBA187P",73,0) ; Check for existing entry "RTN","DVBA187P",74,0) I $G(^DVB(396.6,DVBIEN,0))']"" D Q "RTN","DVBA187P",75,0) . D BMES^XPDUTL("No entry found at #"_DVBIEN) "RTN","DVBA187P",76,0) ; "RTN","DVBA187P",77,0) ; Check for previous update "RTN","DVBA187P",78,0) I $P(^DVB(396.6,DVBIEN,0),"^",1)=DVBEXMN D Q "RTN","DVBA187P",79,0) . D BMES^XPDUTL("Entry at ien #"_DVBIEN_" has previously been updated") "RTN","DVBA187P",80,0) ; "RTN","DVBA187P",81,0) ; Check for correct entry NAME to update "RTN","DVBA187P",82,0) I $P(^DVB(396.6,DVBIEN,0),"^",1)'=DVBEXMO D Q "RTN","DVBA187P",83,0) . D BMES^XPDUTL("Entry at ien #"_DVBIEN_" does not match expected name "_DVBEXMO_" No updating will take place") "RTN","DVBA187P",84,0) ; "RTN","DVBA187P",85,0) ; Update entry "RTN","DVBA187P",86,0) S DVBAFDA(396.6,+DVBIEN_",",.01)=$G(DVBEXMN) D "RTN","DVBA187P",87,0) . D FILE^DIE("","DVBAFDA","DVBAERR") "RTN","DVBA187P",88,0) ; "RTN","DVBA187P",89,0) ; Report sucessful update "RTN","DVBA187P",90,0) ; "RTN","DVBA187P",91,0) I $D(DVBAERR("DIERR"))'>0 D Q "RTN","DVBA187P",92,0) . D BMES^XPDUTL("Renamed entry #"_DVBIEN_" from "_DVBEXMO_" to "_DVBEXMN) "RTN","DVBA187P",93,0) ; "RTN","DVBA187P",94,0) ; Report update error "RTN","DVBA187P",95,0) ; "RTN","DVBA187P",96,0) I $D(DVBAERR("DIERR"))>0 D "RTN","DVBA187P",97,0) . D BMES^XPDUTL(" *** Warning - Unable to update entry #"_DVBIEN_" *** ") "RTN","DVBA187P",98,0) . D MSG^DIALOG() "RTN","DVBA187P",99,0) Q "RTN","DVBA187P",100,0) ; "RTN","DVBA187P",101,0) INACAMIE ;Inactivate exams "RTN","DVBA187P",102,0) ; "RTN","DVBA187P",103,0) N DVBAI,DVBLINE,DVBIEN,DVBEXM "RTN","DVBA187P",104,0) ; "RTN","DVBA187P",105,0) D BMES^XPDUTL(" Inactivating AMIE EXAM (#396.6) file entries...") "RTN","DVBA187P",106,0) D MES^XPDUTL("") "RTN","DVBA187P",107,0) F DVBAI=1:1 S DVBLINE=$P($T(AMIEOLD+DVBAI),";;",2) Q:DVBLINE="QUIT" D "RTN","DVBA187P",108,0) . N DVBAMSG "RTN","DVBA187P",109,0) . S DVBIEN=$P(DVBLINE,";",1) "RTN","DVBA187P",110,0) . S DVBEXM=$P(DVBLINE,";",2) "RTN","DVBA187P",111,0) . ;D BMES^XPDUTL("Going to INACTEXM^DVBAUTLP with DVBIEN="_DVBIEN_", DVBEXM="_DVBEXM_", and the message array passed") "RTN","DVBA187P",112,0) . D INACTEXM^DVBAUTLP(DVBIEN,DVBEXM,.DVBAMSG) "RTN","DVBA187P",113,0) . ; Display status message returned, if any "RTN","DVBA187P",114,0) . D:$D(DVBAMSG)>0 MES^XPDUTL(.DVBAMSG) "RTN","DVBA187P",115,0) . D MES^XPDUTL("") "RTN","DVBA187P",116,0) D BMES^XPDUTL(" Completed Inactivating AMIE EXAM (#396.6) file entries...") "RTN","DVBA187P",117,0) Q "RTN","DVBA187P",118,0) ; "RTN","DVBA187P",119,0) RENMEDOP ; "RTN","DVBA187P",120,0) D BMES^XPDUTL(" Changing PRINT NAME of DBQ Medical Opinion to DBQ MEDICAL OPINION") "RTN","DVBA187P",121,0) I $P($G(^DVB(396.6,437,0)),"^",1)'="DBQ Medical Opinion" D Q "RTN","DVBA187P",122,0) . D BMES^XPDUTL(" Could not change PRINT NAME of DBQ Medical Opinion to DBQ MEDICAL OPINION") "RTN","DVBA187P",123,0) N DVBAERR "RTN","DVBA187P",124,0) S DVBAFDA(396.6,437_",",6)="DBQ MEDICAL OPINION" D FILE^DIE("","DVBAFDA","DVBAERR") "RTN","DVBA187P",125,0) I $D(DVBAERR("DIERR"))'>0 D "RTN","DVBA187P",126,0) . D BMES^XPDUTL("DBQ Medical Opinion print name changed to DBQ MEDICAL OPINION") "RTN","DVBA187P",127,0) I $D(DVBAERR("DIERR"))>0 D "RTN","DVBA187P",128,0) . D BMES^XPDUTL("Could not change DBQ Medical Opinion print name to DBQ MEDICAL OPINION") "RTN","DVBA187P",129,0) Q "RTN","DVBA187P",130,0) ; "RTN","DVBA187P",131,0) SECKEY ; "RTN","DVBA187P",132,0) ; "RTN","DVBA187P",133,0) N XDUZ,KEYNUM,XIEN,XMNU,STOP1,ZTST,OPTIEN,PERDUZ,MSG,ERR,KEYIEN,PERSON,TODAY,X,ZZ "RTN","DVBA187P",134,0) ; "RTN","DVBA187P",135,0) S ZZ="" D OWNSKEY^XUSRB(.ZZ,"XUMGR",DUZ) "RTN","DVBA187P",136,0) I $G(ZZ(0))'=1 D Q "RTN","DVBA187P",137,0) . D BMES^XPDUTL("NOTE: THE NEW SECURITY KEY 'DVBA CAPRI GETVBADOCS' DID NOT SUCCESSFULLY UPDATE WITH THE REQUIRED HOLDERS.") "RTN","DVBA187P",138,0) . D BMES^XPDUTL("THE USER RUNNING THIS POST INSTALL ROUTINE DOES NOT HAVE XUMGR KEY ASSIGNED TO THEM.") "RTN","DVBA187P",139,0) . D BMES^XPDUTL("PLEASE RUN SECKEY^DVBA187P AGAIN WITH USER WHO IS A HOLDER OF THE 'XUMGR' SECURITY KEY.") "RTN","DVBA187P",140,0) ; "RTN","DVBA187P",141,0) K ^TMP($J,"DVBA187P") "RTN","DVBA187P",142,0) ; "RTN","DVBA187P",143,0) D NOW^%DTC S TODAY=X "RTN","DVBA187P",144,0) ; "RTN","DVBA187P",145,0) ;FIND DVBA CAPRI GUI IN OPTION FILE (SHOULD ALWAYS BE 9510) BUT CHECKING JUST THE SAME "RTN","DVBA187P",146,0) S STOP1=0,OPTIEN="" "RTN","DVBA187P",147,0) S XIEN=0 F S XIEN=$O(^DIC(19,XIEN)) Q:XIEN=""!('XIEN)!(STOP1=1) D "RTN","DVBA187P",148,0) . S ZTST=$G(^DIC(19,XIEN,0),"") "RTN","DVBA187P",149,0) . S ZTST=$P(ZTST,"^",1) "RTN","DVBA187P",150,0) . I ZTST="DVBA CAPRI GUI" S STOP1=1,OPTIEN=XIEN "RTN","DVBA187P",151,0) I OPTIEN="" D BMES^XPDUTL("'DVBA CAPRI GUI' OPTION NOT FOUND IN OPTION FILE. USERS OF DVBA CAPRI GETVBADOCS COULD NOT BE SETUP") Q "RTN","DVBA187P",152,0) ; "RTN","DVBA187P",153,0) ;FIND PERSONS WITH DVBA CAPRI GUI OPTION "RTN","DVBA187P",154,0) I OPTIEN'="" D "RTN","DVBA187P",155,0) . S PERDUZ=0 F S PERDUZ=$O(^VA(200,PERDUZ)) Q:PERDUZ=""!('PERDUZ) D "RTN","DVBA187P",156,0) .. K MSG,ERR "RTN","DVBA187P",157,0) .. D GETS^DIQ(200,PERDUZ_",","9.2","I","MSG","ERR") "RTN","DVBA187P",158,0) .. I $G(MSG(200,PERDUZ_",",9.2,"I"))'="",($G(MSG(200,PERDUZ_",",9.2,"I"))<=TODAY) D Q "RTN","DVBA187P",159,0) ... S ^TMP($J,"DVBA187P",PERDUZ,"TERMEDPERSON")="" "RTN","DVBA187P",160,0) .. ; "RTN","DVBA187P",161,0) .. I $G(^VA(200,PERDUZ,201)) I $P(^VA(200,PERDUZ,201),"^",1)=OPTIEN S ^TMP($J,"DVBA187P",PERDUZ,"USERSWITHOPTION")="" Q "RTN","DVBA187P",162,0) .. Q:'$D(^VA(200,PERDUZ,203)) "RTN","DVBA187P",163,0) .. S STOP1=0 "RTN","DVBA187P",164,0) .. S XMNU=0 F S XMNU=$O(^VA(200,PERDUZ,203,XMNU)) Q:XMNU=""!('XMNU)!(STOP1=1) D "RTN","DVBA187P",165,0) ... I $G(^VA(200,PERDUZ,203,XMNU,0)) I $P(^VA(200,PERDUZ,203,XMNU,0),"^",1)=OPTIEN S STOP1=1,^TMP($J,"DVBA187P",PERDUZ,"USERSWITHOPTION")="" "RTN","DVBA187P",166,0) ; "RTN","DVBA187P",167,0) ;DOES THE USER HAVE ACCESS TO THE CURRENT KEY "RTN","DVBA187P",168,0) S KEYNUM=$$LKUP^XPDKEY("DVBA CAPRI DENY_GETVBADOCS") "RTN","DVBA187P",169,0) I $G(KEYNUM)="" D BMES^XPDUTL("'DVBA CAPRI DENY_GETVBADOCS' SECURITY KEY HAS ALREADY BEEN DELETED. SECKEY^DVBA187P CAN NOT CONTINUE") Q "RTN","DVBA187P",170,0) S PERDUZ=0 F S PERDUZ=$O(^VA(200,PERDUZ)) Q:PERDUZ=""!('PERDUZ) D "RTN","DVBA187P",171,0) . I $D(^VA(200,PERDUZ,51,KEYNUM)) D Q "RTN","DVBA187P",172,0) .. S ^TMP($J,"DVBA187P",PERDUZ,"DVBA CAPRI DENY_GETVBADOCS")="" "RTN","DVBA187P",173,0) .. I $D(^TMP($J,"DVBA187P",PERDUZ,"USERSWITHOPTION")) S ^TMP($J,"DVBA187P",PERDUZ,"USERSWITHOPTION")="DVBA CAPRI DENY_GETVBADOCS" "RTN","DVBA187P",174,0) ; "RTN","DVBA187P",175,0) ;ADD NEW SECURITY KEY TO ALL NON-TERMED PERSONS WHO DON'T HAVE OLD KEY "RTN","DVBA187P",176,0) S KEYNUM=$$LKUP^XPDKEY("DVBA CAPRI GETVBADOCS") "RTN","DVBA187P",177,0) I $G(KEYNUM)="" D BMES^XPDUTL("'DVBA CAPRI GETVBADOCS' SECURITY KEY HAS NOT BEEN INSTALLED ON SYSTEM. INSTALL AND RERUN SECKEY^DVBA187P") Q "RTN","DVBA187P",178,0) S PERDUZ=0 F S PERDUZ=$O(^TMP($J,"DVBA187P",PERDUZ)) Q:PERDUZ=""!('PERDUZ) D "RTN","DVBA187P",179,0) . Q:$D(^VA(200,PERDUZ,3,"B","VISITOR"))=10 ;DO NOT INCLUDE USERS WHO ARE VISITORS "RTN","DVBA187P",180,0) . Q:'$D(^TMP($J,"DVBA187P",PERDUZ,"USERSWITHOPTION")) "RTN","DVBA187P",181,0) . Q:$D(^TMP($J,"DVBA187P",PERDUZ,"TERMEDPERSON")) "RTN","DVBA187P",182,0) . Q:$D(^TMP($J,"DVBA187P",PERDUZ,"DVBA CAPRI DENY_GETVBADOCS")) "RTN","DVBA187P",183,0) . ;IF AFTER FIRST RUN THIS ROUTINE IS RUN AGAIN EXCLUDE PERSON WITH KEY FROM FIRST RUN "RTN","DVBA187P",184,0) . Q:$D(^XUSEC("DVBA CAPRI GETVBADOCS",PERDUZ)) "RTN","DVBA187P",185,0) . K FDA,ERR,DIERR,KEYIEN "RTN","DVBA187P",186,0) . S FDA(200.051,"+1,"_PERDUZ_",",.01)=KEYNUM "RTN","DVBA187P",187,0) . S FDA(200.051,"+1,"_PERDUZ_",",1)=DUZ "RTN","DVBA187P",188,0) . S FDA(200.051,"+1,"_PERDUZ_",",2)=TODAY "RTN","DVBA187P",189,0) . S KEYIEN(1)=KEYNUM "RTN","DVBA187P",190,0) . D UPDATE^DIE("","FDA","KEYIEN","ERR") "RTN","DVBA187P",191,0) . S PERSON=$P(^VA(200,PERDUZ,0),"^",1) "RTN","DVBA187P",192,0) . I $D(DIERR) D BMES^XPDUTL("PERSON DUZ: "_PERDUZ_" ("_PERSON_") SHOULD BE ASSIGNED THE SECURITY KEY 'DVBA CAPRI GETVBADOCS' BUT COULD NOT IN THE DVBA*2.7*187 POST INSTALL ROUTINE. PLEASE SET THIS PERSON MANUALLY") Q "RTN","DVBA187P",193,0) . D BMES^XPDUTL("PERSON DUZ: "_PERDUZ_" ("_PERSON_") HAS BEEN ASSIGNED THE NEW SECURITY KEY 'DVBA CAPRI GETVBADOCS'") "RTN","DVBA187P",194,0) ; "RTN","DVBA187P",195,0) K ^TMP($J,"DVBA187P") "RTN","DVBA187P",196,0) D BMES^XPDUTL("OK to delete DVBA187P") "RTN","DVBA187P",197,0) Q "RTN","DVBA187P",198,0) ; "RTN","DVBA187P",199,0) ;*************************************************************************** "RTN","DVBA187P",200,0) ; AMIE EXAM (#396.6) file exam(s) to activate (create or update). "RTN","DVBA187P",201,0) ; Data should be in internal format. "RTN","DVBA187P",202,0) ; format: ien;exam name (60 chars);print name;body system;routine;status;;wks# "RTN","DVBA187P",203,0) ;*************************************************************************** "RTN","DVBA187P",204,0) ; "RTN","DVBA187P",205,0) AMIENEW ; "RTN","DVBA187P",206,0) ;;463;DBQ Medical SHA;DBQ SEPRATN HEALTH ASMNT;1;DVBCQDRV;A; ; ; "RTN","DVBA187P",207,0) ;;QUIT "RTN","DVBA187P",208,0) ; "RTN","DVBA187P",209,0) Q "RTN","DVBA187P",210,0) ; "RTN","DVBA187P",211,0) ; ************************************************************************** "RTN","DVBA187P",212,0) ; AMIE EXAM (#396.6) file exam(s) to rename. Data should be in internal format. "RTN","DVBA187P",213,0) ; Format: ;;ien;"old" exam name(up to 60 chars);"new" exam name(up to 60 chars) "RTN","DVBA187P",214,0) ; "RTN","DVBA187P",215,0) ; ************************************************************************** "RTN","DVBA187P",216,0) EXOLDNEW ; "RTN","DVBA187P",217,0) ;;437;DBQ Medical Opinion 1;DBQ Medical Opinion "RTN","DVBA187P",218,0) ;;QUIT "RTN","DVBA187P",219,0) ;; "RTN","DVBA187P",220,0) Q "RTN","DVBA187P",221,0) ;*************************************************************************** "RTN","DVBA187P",222,0) ; AMIE EXAM (#396.6) file exam(s) to deactivate. Data should be in "RTN","DVBA187P",223,0) ; internal format. "RTN","DVBA187P",224,0) ; Format: ien;exam name (60 chars); "RTN","DVBA187P",225,0) ;*************************************************************************** "RTN","DVBA187P",226,0) ; "RTN","DVBA187P",227,0) AMIEOLD ; "RTN","DVBA187P",228,0) ;;416;DBQ MUSC Flatfoot (pes planus);16;DVBCQDRV;I;; "RTN","DVBA187P",229,0) ;;433;DBQ CARDIO Ischemic heart disease;6;DVBCQDRV;I;; "RTN","DVBA187P",230,0) ;;438;DBQ Medical Opinion 2;17;DVBCQDRV;I;; "RTN","DVBA187P",231,0) ;;439;DBQ Medical Opinion 3;17;DVBCQDRV;I;; "RTN","DVBA187P",232,0) ;;440;DBQ Medical Opinion 4;17;DVBCQDRV;I;; "RTN","DVBA187P",233,0) ;;441;DBQ Medical Opinion 5;17;DVBCQDRV;I;; "RTN","DVBA187P",234,0) ;;QUIT "RTN","DVBA187P",235,0) ; "RTN","DVBA187P",236,0) Q "RTN","DVBAB1A") 0^2^B29208076^B28591193 "RTN","DVBAB1A",1,0) DVBAB1A ;ALB/GAK - CAPRI Exam Complete Email Driver ; 03/13/2013 11:23 AM "RTN","DVBAB1A",2,0) ;;2.7;AMIE;**185,187**;Apr 10, 1995;Build 13 "RTN","DVBAB1A",3,0) ; "RTN","DVBAB1A",4,0) Q "RTN","DVBAB1A",5,0) ; "RTN","DVBAB1A",6,0) MSG2(ERR,DUZ,RIEN,ELIST) ; "RTN","DVBAB1A",7,0) ; "RTN","DVBAB1A",8,0) ;DUZ PERSON FILE DFN "RTN","DVBAB1A",9,0) ;RIEN 2507 REQUEST IEN #396.3 "RTN","DVBAB1A",10,0) ;ELIST 2507 EXAM LIST #396.4 "RTN","DVBAB1A",11,0) ; "RTN","DVBAB1A",12,0) N DVBOPEN,DVBOPENS,DVBOPENC,J "RTN","DVBAB1A",13,0) N PNAM,PSSN,CNUM,ERR3,ERR2,ERR4,RTN,RTN2,XX "RTN","DVBAB1A",14,0) N POE "RTN","DVBAB1A",15,0) N EIEN,EARY,EERR,ENAM,ESTA "RTN","DVBAB1A",16,0) N XMTEXT,L,XMSUB,XMY "RTN","DVBAB1A",17,0) ; "RTN","DVBAB1A",18,0) S ERR="" "RTN","DVBAB1A",19,0) I DUZ="" S ERR="NO DUZ PASSED" Q ERR "RTN","DVBAB1A",20,0) I RIEN="" S ERR="NO REQUEST IEN PASSED" Q ERR "RTN","DVBAB1A",21,0) I $D(ELIST)'>1 S ERR="NO EXAM LIST PASSED" Q ERR "RTN","DVBAB1A",22,0) ; "RTN","DVBAB1A",23,0) K ^TMP($J,"DVBAB1A") "RTN","DVBAB1A",24,0) K ^TMP($J,"AMIE") "RTN","DVBAB1A",25,0) K ^TMP($J,"AMIE1") "RTN","DVBAB1A",26,0) ; "RTN","DVBAB1A",27,0) S J="" "RTN","DVBAB1A",28,0) F S J=$O(ELIST(J)) Q:J="" D "RTN","DVBAB1A",29,0) . S ^TMP($J,"DVBAB1A","ELIST",J)=J "RTN","DVBAB1A",30,0) ; "RTN","DVBAB1A",31,0) ;Determine and count number of open exams on 2507 request "RTN","DVBAB1A",32,0) S DVBOPEN="" "RTN","DVBAB1A",33,0) S DVBOPENS=0,DVBOPENC=0 "RTN","DVBAB1A",34,0) D FINDEXAM^DVBAB1(.DVBOPEN,RIEN) "RTN","DVBAB1A",35,0) S J="" F S J=$O(DVBOPEN(J)) Q:J="" D "RTN","DVBAB1A",36,0) . I $E(DVBOPEN(J),($L(DVBOPEN(J))-5),$L(DVBOPEN(J)))="[OPEN]" S DVBOPENS=1,DVBOPENC=DVBOPENC+1 "RTN","DVBAB1A",37,0) ; "RTN","DVBAB1A",38,0) ;Determine patient name, SSN and C-Number "RTN","DVBAB1A",39,0) S (PNAM,PSSN,CNUM,ERR3,ERR2,RTN,RTN2,XX)="" "RTN","DVBAB1A",40,0) K RTN,ERR3 "RTN","DVBAB1A",41,0) D GETS^DIQ(396.3,RIEN,".01","I","RTN","ERR3") "RTN","DVBAB1A",42,0) I $D(RTN) D "RTN","DVBAB1A",43,0) . S XX=""_".01;.09;.313"_"" "RTN","DVBAB1A",44,0) . K RTN2,ERR2 "RTN","DVBAB1A",45,0) . D GETS^DIQ(2,RTN(396.3,RIEN_",",.01,"I"),XX,"E","RTN2","ERR2") "RTN","DVBAB1A",46,0) . S PNAM=$G(RTN2(2,RTN(396.3,RIEN_",",.01,"I")_",",.01,"E")) "RTN","DVBAB1A",47,0) . S PSSN=$G(RTN2(2,RTN(396.3,RIEN_",",.01,"I")_",",.09,"E")) "RTN","DVBAB1A",48,0) . S CNUM=$G(RTN2(2,RTN(396.3,RIEN_",",.01,"I")_",",.313,"E")) "RTN","DVBAB1A",49,0) S:'$D(PNAM) PNAM="" "RTN","DVBAB1A",50,0) S:'$D(PSSN) PSSN="" "RTN","DVBAB1A",51,0) S:'$D(CNUM) CNUM="" "RTN","DVBAB1A",52,0) ; "RTN","DVBAB1A",53,0) ;Build Exam Array Info "RTN","DVBAB1A",54,0) K ^TMP($J,"DVBAB1A","ELIST") "RTN","DVBAB1A",55,0) S J="" "RTN","DVBAB1A",56,0) F S J=$O(ELIST(J)) Q:J="" D "RTN","DVBAB1A",57,0) . S EIEN=ELIST(J) "RTN","DVBAB1A",58,0) . K EARY,EERR "RTN","DVBAB1A",59,0) . D GETS^DIQ(396.4,EIEN,".03;.04","IE","EARY","EERR") "RTN","DVBAB1A",60,0) . Q:'$D(EARY(396.4,EIEN_",",.03,"E")) "RTN","DVBAB1A",61,0) . S ENAM=$G(EARY(396.4,EIEN_",",.03,"E")) "RTN","DVBAB1A",62,0) . S ESTA=$G(EARY(396.4,EIEN_",",.04,"E")) "RTN","DVBAB1A",63,0) . S ^TMP($J,"DVBAB1A","ELIST",J)=ENAM_$E(" ",1,35-$L(ENAM))_" "_ESTA "RTN","DVBAB1A",64,0) ; "RTN","DVBAB1A",65,0) ;Determine Priority of Exam "RTN","DVBAB1A",66,0) K ERR4 "RTN","DVBAB1A",67,0) S POE=$$GET1^DIQ(396.3,RIEN_",",9,"E","","ERR4") "RTN","DVBAB1A",68,0) I '$D(POE) S POE="" "RTN","DVBAB1A",69,0) ; "RTN","DVBAB1A",70,0) ; "RTN","DVBAB1A",71,0) ; "RTN","DVBAB1A",72,0) D ONEEMAIL "RTN","DVBAB1A",73,0) K ^TMP($J,"DVBAB1A","ELIST") "RTN","DVBAB1A",74,0) K ^TMP($J,"AMIE") "RTN","DVBAB1A",75,0) K ^TMP($J,"AMIE1") "RTN","DVBAB1A",76,0) I $D(ERR) Q ERR "RTN","DVBAB1A",77,0) ; "RTN","DVBAB1A",78,0) Q "RTN","DVBAB1A",79,0) ; "RTN","DVBAB1A",80,0) ; "RTN","DVBAB1A",81,0) ; "RTN","DVBAB1A",82,0) ONEEMAIL ; "RTN","DVBAB1A",83,0) K ERR "RTN","DVBAB1A",84,0) N DVBA0,DVBADFN,DVBASITE,DVBADT,DVBAREQ,DVBAEA "RTN","DVBAB1A",85,0) S XMDUZ=DUZ "RTN","DVBAB1A",86,0) ;following call supported by IA 3858 "RTN","DVBAB1A",87,0) N DUZ "RTN","DVBAB1A",88,0) ;SINCE MAILMAN DOES NOT ALLOW MESSAGES TO BE SENT FROM USERS WITHOUT ACCESS CODES OR MAILBOXES "RTN","DVBAB1A",89,0) ;WHICH CAPRI REMOTE USER DO NOT HAVE, WE HAVE TO NEW DUZ AND CHANGE XMDUZ TO THE NAME OF THE USER "RTN","DVBAB1A",90,0) ;AS A STRING SO THE PROCESS IS STILL LINKED TO THE USER SENDING/TRIGGERING THE MESSAGE "RTN","DVBAB1A",91,0) ; "RTN","DVBAB1A",92,0) S XMDUZ=$P($G(^VA(200,XMDUZ,0)),"^",1)_" CAPRI" "RTN","DVBAB1A",93,0) I $G(^DVB(396.3,RIEN,0))="" S ERR="INVALID REQUEST 396.3 TOP NODE" Q "RTN","DVBAB1A",94,0) S DVBA0=$G(^DVB(396.3,RIEN,0)) "RTN","DVBAB1A",95,0) S DVBADFN=$P(DVBA0,"^",1),DVBAREQ=$P(DVBA0,"^",4),DVBADT=$$FMTE^XLFDT($P(DVBA0,"^",2)) "RTN","DVBAB1A",96,0) ;following call supported by IA 3858 "RTN","DVBAB1A",97,0) ;rra 938270 make sure email address exists prior to attempting to send notification "RTN","DVBAB1A",98,0) S DVBAEA=$P($G(^VA(200,DVBAREQ,.15)),"^",1) "RTN","DVBAB1A",99,0) I DVBAEA="" Q "RTN","DVBAB1A",100,0) S XMY(DVBAEA)="" "RTN","DVBAB1A",101,0) ; "RTN","DVBAB1A",102,0) S DVBASITE=$$SITE^VASITE "RTN","DVBAB1A",103,0) I '$D(DVBASITE) S DVBASITE="^" "RTN","DVBAB1A",104,0) ; "RTN","DVBAB1A",105,0) S XMSUB="CAPRI: Completion of 2507 Exams" "RTN","DVBAB1A",106,0) ; "RTN","DVBAB1A",107,0) S L=0 "RTN","DVBAB1A",108,0) S L=L+1 "RTN","DVBAB1A",109,0) S ^TMP($J,"AMIE",L)="The following veteran had one or more 2507 exams completed.",L=L+1 "RTN","DVBAB1A",110,0) I DVBOPENS=0 S ^TMP($J,"AMIE",L)="A 2507 request as described below has been completed and released to the regional office and is now available in CAPRI.",L=L+1 "RTN","DVBAB1A",111,0) S ^TMP($J,"AMIE",L)=" ",L=L+1 "RTN","DVBAB1A",112,0) S ^TMP($J,"AMIE",L)="DFN: `"_DVBADFN_" SITE: "_$P($G(DVBASITE),"^",2)_" Request Date: "_DVBADT "RTN","DVBAB1A",113,0) S L=L+1 "RTN","DVBAB1A",114,0) S ^TMP($J,"AMIE",L)=" ",L=L+1 "RTN","DVBAB1A",115,0) ; "RTN","DVBAB1A",116,0) S ^TMP($J,"AMIE",L)=" Priority of Exam: "_POE,L=L+1 "RTN","DVBAB1A",117,0) S ^TMP($J,"AMIE",L)=" ",L=L+1 "RTN","DVBAB1A",118,0) ; "RTN","DVBAB1A",119,0) S ^TMP($J,"AMIE",L)="Exam(s)",L=L+1 "RTN","DVBAB1A",120,0) S ^TMP($J,"AMIE",L)=" EXAM TYPE STATUS",L=L+1 "RTN","DVBAB1A",121,0) ; "RTN","DVBAB1A",122,0) S J="" "RTN","DVBAB1A",123,0) F S J=$O(^TMP($J,"DVBAB1A","ELIST",J)) Q:J="" D "RTN","DVBAB1A",124,0) . S ^TMP($J,"AMIE",L)=" "_^TMP($J,"DVBAB1A","ELIST",J),L=L+1 "RTN","DVBAB1A",125,0) ; "RTN","DVBAB1A",126,0) S ^TMP($J,"AMIE",L)=" ",L=L+1 "RTN","DVBAB1A",127,0) S ^TMP($J,"AMIE",L)=" ",L=L+1 "RTN","DVBAB1A",128,0) ; "RTN","DVBAB1A",129,0) I DVBOPENS=1 S ^TMP($J,"AMIE",L)="*** Number of exams still open on this request: "_DVBOPENC_" ***",L=L+1 "RTN","DVBAB1A",130,0) I DVBOPENS=0 S ^TMP($J,"AMIE",L)="*** This is the last exam to be completed on this 2507 request. ***",L=L+1 "RTN","DVBAB1A",131,0) ; "RTN","DVBAB1A",132,0) S ^TMP($J,"AMIE",L)=" ",L=L+1 "RTN","DVBAB1A",133,0) S ^TMP($J,"AMIE",L)=" ",L=L+1 "RTN","DVBAB1A",134,0) S ^TMP($J,"AMIE",L)="** NOTE: To view the patient using the DFN, paste the DFN number into the CAPRI **",L=L+1 "RTN","DVBAB1A",135,0) S ^TMP($J,"AMIE",L)="** Patient Selector 'Patient ID' field to find the patient. Be sure to include **",L=L+1 "RTN","DVBAB1A",136,0) S ^TMP($J,"AMIE",L)="** the ` (backward-apostrophe) character. **",L=L+1 "RTN","DVBAB1A",137,0) S ^TMP($J,"AMIE",L)=" ",L=L+1 "RTN","DVBAB1A",138,0) S ^TMP($J,"AMIE",L)="*****This is an auto-generated email. Do not respond to this email address.*****",L=L+1 "RTN","DVBAB1A",139,0) ; "RTN","DVBAB1A",140,0) S XMTEXT="^TMP($J,""AMIE""," "RTN","DVBAB1A",141,0) ; "RTN","DVBAB1A",142,0) D ^XMD "RTN","DVBAB1A",143,0) ; "RTN","DVBAB1A",144,0) I $D(XMMG) S ERR=XMMG "RTN","DVBAB1A",145,0) I $D(XMZ) S ERR="MESSAGE SENT" "RTN","DVBAB1A",146,0) ; "RTN","DVBAB1A",147,0) Q "VER") 8.0^22.0 "^DD",396.3,396.3,46,0) REQUEST UUID^F^^7;2^K:$L(X)>36!($L(X)<1) X "^DD",396.3,396.3,46,3) Answer must be 1-36 characters in length. "^DD",396.3,396.3,46,21,0) ^^2^2^3140707^ "^DD",396.3,396.3,46,21,1,0) This field is the Request UUID (universally unique identifier for VLER "^DD",396.3,396.3,46,21,2,0) DAS.) "^DD",396.3,396.3,46,"DT") 3140707 "^DD",396.45,396.45,105,0) VLER ENABLED^RS^Y:YES;N:NO;^VNDRSFTP1;2^Q "^DD",396.45,396.45,105,3) Answer "YES" if the contractor is VLER enabled "^DD",396.45,396.45,105,21,0) ^^1^1^3140710^ "^DD",396.45,396.45,105,21,1,0) This field is used to determine if the contractor is VLER enabled. "^DD",396.45,396.45,105,"DT") 3140710 "BLD",8596,6) ^165 **END** **END**