EMERGENCY Released DG*5.3*856 SEQ #754 Extracted from mail message **KIDS**:DG*5.3*856^ **INSTALL NAME** DG*5.3*856 "BLD",2917,0) DG*5.3*856^REGISTRATION^0^3120524^y "BLD",2917,1,0) ^^4^4^3120522^ "BLD",2917,1,1,0) TREATING FACILITY LIST (#391.91) FILE ISSUES "BLD",2917,1,2,0) "BLD",2917,1,3,0) Refer to patch DG*5.3*856 in the FORUM Patch Module for a complete "BLD",2917,1,4,0) description. "BLD",2917,4,0) ^9.64PA^391.91^1 "BLD",2917,4,391.91,0) 391.91 "BLD",2917,4,391.91,2,0) ^9.641^391.91^1 "BLD",2917,4,391.91,2,391.91,0) TREATING FACILITY LIST (File-top level) "BLD",2917,4,391.91,2,391.91,1,0) ^9.6411^10^4 "BLD",2917,4,391.91,2,391.91,1,.02,0) INSTITUTION "BLD",2917,4,391.91,2,391.91,1,.09,0) SOURCE ID TYPE "BLD",2917,4,391.91,2,391.91,1,10,0) ASSIGNING AUTHORITY "BLD",2917,4,391.91,2,391.91,1,11,0) SOURCE ID "BLD",2917,4,391.91,222) y^n^p^^^^n^^n "BLD",2917,4,391.91,224) "BLD",2917,4,"APDD",391.91,391.91) "BLD",2917,4,"APDD",391.91,391.91,.02) "BLD",2917,4,"APDD",391.91,391.91,.09) "BLD",2917,4,"APDD",391.91,391.91,10) "BLD",2917,4,"APDD",391.91,391.91,11) "BLD",2917,4,"B",391.91,391.91) "BLD",2917,6.3) 5 "BLD",2917,"ABPKG") n "BLD",2917,"INIT") EP^DG53856P "BLD",2917,"KRN",0) ^9.67PA^779.2^20 "BLD",2917,"KRN",.4,0) .4 "BLD",2917,"KRN",.401,0) .401 "BLD",2917,"KRN",.402,0) .402 "BLD",2917,"KRN",.403,0) .403 "BLD",2917,"KRN",.5,0) .5 "BLD",2917,"KRN",.84,0) .84 "BLD",2917,"KRN",3.6,0) 3.6 "BLD",2917,"KRN",3.8,0) 3.8 "BLD",2917,"KRN",9.2,0) 9.2 "BLD",2917,"KRN",9.8,0) 9.8 "BLD",2917,"KRN",9.8,"NM",0) ^9.68A^5^5 "BLD",2917,"KRN",9.8,"NM",1,0) VAFCTFU2^^0^B47326411 "BLD",2917,"KRN",9.8,"NM",2,0) DG53856P^^0^B5103050 "BLD",2917,"KRN",9.8,"NM",3,0) VAFCTFU^^0^B67856699 "BLD",2917,"KRN",9.8,"NM",4,0) VAFCTFU1^^0^B11999906 "BLD",2917,"KRN",9.8,"NM",5,0) VAFCTF^^0^B10514469 "BLD",2917,"KRN",9.8,"NM","B","DG53856P",2) "BLD",2917,"KRN",9.8,"NM","B","VAFCTF",5) "BLD",2917,"KRN",9.8,"NM","B","VAFCTFU",3) "BLD",2917,"KRN",9.8,"NM","B","VAFCTFU1",4) "BLD",2917,"KRN",9.8,"NM","B","VAFCTFU2",1) "BLD",2917,"KRN",19,0) 19 "BLD",2917,"KRN",19.1,0) 19.1 "BLD",2917,"KRN",101,0) 101 "BLD",2917,"KRN",409.61,0) 409.61 "BLD",2917,"KRN",771,0) 771 "BLD",2917,"KRN",779.2,0) 779.2 "BLD",2917,"KRN",870,0) 870 "BLD",2917,"KRN",8989.51,0) 8989.51 "BLD",2917,"KRN",8989.52,0) 8989.52 "BLD",2917,"KRN",8994,0) 8994 "BLD",2917,"KRN","B",.4,.4) "BLD",2917,"KRN","B",.401,.401) "BLD",2917,"KRN","B",.402,.402) "BLD",2917,"KRN","B",.403,.403) "BLD",2917,"KRN","B",.5,.5) "BLD",2917,"KRN","B",.84,.84) "BLD",2917,"KRN","B",3.6,3.6) "BLD",2917,"KRN","B",3.8,3.8) "BLD",2917,"KRN","B",9.2,9.2) "BLD",2917,"KRN","B",9.8,9.8) "BLD",2917,"KRN","B",19,19) "BLD",2917,"KRN","B",19.1,19.1) "BLD",2917,"KRN","B",101,101) "BLD",2917,"KRN","B",409.61,409.61) "BLD",2917,"KRN","B",771,771) "BLD",2917,"KRN","B",779.2,779.2) "BLD",2917,"KRN","B",870,870) "BLD",2917,"KRN","B",8989.51,8989.51) "BLD",2917,"KRN","B",8989.52,8989.52) "BLD",2917,"KRN","B",8994,8994) "BLD",2917,"PRET") "BLD",2917,"QDEF") ^^^^NO^^^^^^YES "BLD",2917,"QUES",0) ^9.62^^ "BLD",2917,"REQB",0) ^9.611^4^4 "BLD",2917,"REQB",1,0) DG*5.3*821^2 "BLD",2917,"REQB",2,0) DG*5.3*837^2 "BLD",2917,"REQB",3,0) DG*5.3*800^2 "BLD",2917,"REQB",4,0) DG*5.3*766^2 "BLD",2917,"REQB","B","DG*5.3*766",4) "BLD",2917,"REQB","B","DG*5.3*800",3) "BLD",2917,"REQB","B","DG*5.3*821",1) "BLD",2917,"REQB","B","DG*5.3*837",2) "FIA",391.91) TREATING FACILITY LIST "FIA",391.91,0) ^DGCN(391.91, "FIA",391.91,0,0) 391.91IP "FIA",391.91,0,1) y^n^p^^^^n^^n "FIA",391.91,0,10) "FIA",391.91,0,11) "FIA",391.91,0,"RLRO") "FIA",391.91,0,"VR") 5.3^DG "FIA",391.91,391.91) 1 "FIA",391.91,391.91,.02) "FIA",391.91,391.91,.09) "FIA",391.91,391.91,10) "FIA",391.91,391.91,11) "INIT") EP^DG53856P "IX",391.91,391.91,"AISS",0) 391.91^AISS^X-REF for fully qualified ID fields^R^^R^IR^I^391.91^^^^^S "IX",391.91,391.91,"AISS",.1,0) ^^3^3^3120514^ "IX",391.91,391.91,"AISS",.1,1,0) The AISS cross-reference will be used to determine the INSTITUTION "IX",391.91,391.91,"AISS",.1,2,0) associated with the fully qualified ID, which is comprised of the SOURCE "IX",391.91,391.91,"AISS",.1,3,0) ID, ASSIGNING AUTHORITY, and SOURCE ID TYPE. "IX",391.91,391.91,"AISS",1) S ^DGCN(391.91,"AISS",$E(X(1),1,150),$E(X(2),1,70),$E(X(3),1,10),$E(X(4),1,10),DA)="" "IX",391.91,391.91,"AISS",2) K ^DGCN(391.91,"AISS",$E(X(1),1,150),$E(X(2),1,70),$E(X(3),1,10),$E(X(4),1,10),DA) "IX",391.91,391.91,"AISS",2.5) K ^DGCN(391.91,"AISS") "IX",391.91,391.91,"AISS",11.1,0) ^.114IA^4^4 "IX",391.91,391.91,"AISS",11.1,1,0) 1^F^391.91^11^150^1^F "IX",391.91,391.91,"AISS",11.1,2,0) 2^F^391.91^10^70^2^F "IX",391.91,391.91,"AISS",11.1,3,0) 3^F^391.91^.09^10^3^F "IX",391.91,391.91,"AISS",11.1,4,0) 4^F^391.91^.02^10^4^F "IX",391.91,391.91,"AKEY",0) 391.91^AKEY^Find entry using all identifier fields.^R^^R^IR^I^391.91^^^^^S "IX",391.91,391.91,"AKEY",.1,0) ^^2^2^3111102^ "IX",391.91,391.91,"AKEY",.1,1,0) This cross-reference will facilitate finding a specific unique identifier "IX",391.91,391.91,"AKEY",.1,2,0) by PATIENT, INSTITUTION, SOURCE ID TYPE, and ASSIGNING AUTHORITY. "IX",391.91,391.91,"AKEY",1) S ^DGCN(391.91,"AKEY",$E(X(1),1,150),X(2),X(3),$E(X(4),1,70),DA)="" "IX",391.91,391.91,"AKEY",2) K ^DGCN(391.91,"AKEY",$E(X(1),1,150),X(2),X(3),$E(X(4),1,70),DA) "IX",391.91,391.91,"AKEY",2.5) K ^DGCN(391.91,"AKEY") "IX",391.91,391.91,"AKEY",11.1,0) ^.114IA^4^4 "IX",391.91,391.91,"AKEY",11.1,1,0) 1^F^391.91^.01^150^1^F "IX",391.91,391.91,"AKEY",11.1,1,3) "IX",391.91,391.91,"AKEY",11.1,2,0) 2^F^391.91^.02^^2^F "IX",391.91,391.91,"AKEY",11.1,2,3) "IX",391.91,391.91,"AKEY",11.1,3,0) 3^F^391.91^.09^^3^F "IX",391.91,391.91,"AKEY",11.1,3,3) "IX",391.91,391.91,"AKEY",11.1,4,0) 4^F^391.91^10^70^4^F "IX",391.91,391.91,"AKEY",11.1,4,3) "IX",391.91,391.91,"AKEY2",0) 391.91^AKEY2^Lookup by PATIENT and ASSIGNING AUTHORITY.^R^^R^IR^I^391.91^^^^^S "IX",391.91,391.91,"AKEY2",.1,0) ^^4^4^3111102^ "IX",391.91,391.91,"AKEY2",.1,1,0) This cross-reference will facilitate finding a specific unique identifier "IX",391.91,391.91,"AKEY2",.1,2,0) by PATIENT and ASSIGNING AUTHORITY when only those data fields are "IX",391.91,391.91,"AKEY2",.1,3,0) present, for example for a National Health Information Exchange (NHIE) "IX",391.91,391.91,"AKEY2",.1,4,0) location. "IX",391.91,391.91,"AKEY2",1) S ^DGCN(391.91,"AKEY2",$E(X(1),1,150),$E(X(2),1,70),DA)="" "IX",391.91,391.91,"AKEY2",2) K ^DGCN(391.91,"AKEY2",$E(X(1),1,150),$E(X(2),1,70),DA) "IX",391.91,391.91,"AKEY2",2.5) K ^DGCN(391.91,"AKEY2") "IX",391.91,391.91,"AKEY2",11.1,0) ^.114IA^2^2 "IX",391.91,391.91,"AKEY2",11.1,1,0) 1^F^391.91^.01^150^1^F "IX",391.91,391.91,"AKEY2",11.1,1,3) "IX",391.91,391.91,"AKEY2",11.1,2,0) 2^F^391.91^10^70^2^F "IX",391.91,391.91,"AKEY2",11.1,2,3) "IX",391.91,391.91,"ASID",0) 391.91^ASID^X-REF on SOURCE ID and INSTITUTION^R^^R^IR^I^391.91^^^^^S "IX",391.91,391.91,"ASID",.1,0) ^^2^2^3111102^ "IX",391.91,391.91,"ASID",.1,1,0) The ASID cross-reference will be used to determine the INSTITUTION "IX",391.91,391.91,"ASID",.1,2,0) associated with the SOURCE ID. "IX",391.91,391.91,"ASID",1) S ^DGCN(391.91,"ASID",$E(X(1),1,150),X(2),DA)="" "IX",391.91,391.91,"ASID",2) K ^DGCN(391.91,"ASID",$E(X(1),1,150),X(2),DA) "IX",391.91,391.91,"ASID",2.5) K ^DGCN(391.91,"ASID") "IX",391.91,391.91,"ASID",11.1,0) ^.114IA^2^2 "IX",391.91,391.91,"ASID",11.1,1,0) 1^F^391.91^11^150^1^F "IX",391.91,391.91,"ASID",11.1,1,3) "IX",391.91,391.91,"ASID",11.1,2,0) 2^F^391.91^.02^^2^F "IX",391.91,391.91,"ASID",11.1,2,3) "MBREQ") 0 "PKG",5,-1) 1^1 "PKG",5,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",5,20,0) ^9.402P^^ "PKG",5,22,0) ^9.49I^1^1 "PKG",5,22,1,0) 5.3^2930813^2970721^12541 "PKG",5,22,1,"PAH",1,0) 856^3120524 "PKG",5,22,1,"PAH",1,1,0) ^^4^4^3120524 "PKG",5,22,1,"PAH",1,1,1,0) TREATING FACILITY LIST (#391.91) FILE ISSUES "PKG",5,22,1,"PAH",1,1,2,0) "PKG",5,22,1,"PAH",1,1,3,0) Refer to patch DG*5.3*856 in the FORUM Patch Module for a complete "PKG",5,22,1,"PAH",1,1,4,0) description. "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") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 5 "RTN","DG53856P") 0^2^B5103050^n/a "RTN","DG53856P",1,0) DG53856P ;BIR/CKN-PATCH DG*5.3*856 POST INSTALLATION ROUTINE ; 5/15/12 6:12pm "RTN","DG53856P",2,0) ;;5.3;Registration;**856**;Aug 13, 1993;Build 5 "RTN","DG53856P",3,0) Q "RTN","DG53856P",4,0) EP ;**856 (ckn) "RTN","DG53856P",5,0) ;Do not run module if patch DG*5.3*856 previously installed. "RTN","DG53856P",6,0) I $$PATCH^XPDUTL("DG*5.3*856") D BMES^XPDUTL("The AISS cross-reference previously created; no action needed.") Q "RTN","DG53856P",7,0) AGN D BMES^XPDUTL("Creating AISS cross-reference on the TREATING FACILITY LIST #391.91 file.") "RTN","DG53856P",8,0) N ZTRTN,ZTDESC,ZTSK "RTN","DG53856P",9,0) S ZTRTN="EN^DG53856P",ZTDESC="DG53856P - INDEX TREATING FACILITY FILE" "RTN","DG53856P",10,0) S ZTIO="",ZTDTH=$H "RTN","DG53856P",11,0) D ^%ZTLOAD "RTN","DG53856P",12,0) I $D(ZTSK) D BMES^XPDUTL("Look for the completion of task #"_ZTSK_" in Taskman.") D MES^XPDUTL("When the task finishes, the AISS cross-reference has been created.") "RTN","DG53856P",13,0) S:$D(ZTQUEUED) ZTREQ="@" "RTN","DG53856P",14,0) Q "RTN","DG53856P",15,0) EN ; "RTN","DG53856P",16,0) N SID,TFIEN,AA,IDTYP,SITE,SITEN,NODE0,NODE2 "RTN","DG53856P",17,0) S TFIEN=0 "RTN","DG53856P",18,0) F S TFIEN=$O(^DGCN(391.91,TFIEN)) Q:'TFIEN D "RTN","DG53856P",19,0) . S NODE0=$G(^DGCN(391.91,TFIEN,0)) "RTN","DG53856P",20,0) . S SITE=$P(NODE0,"^",2) "RTN","DG53856P",21,0) . S IDTYP=$P(NODE0,"^",9) "RTN","DG53856P",22,0) . S NODE2=$G(^DGCN(391.91,TFIEN,2)) "RTN","DG53856P",23,0) . S AA=$P(NODE2,"^"),SID=$P(NODE2,"^",2) "RTN","DG53856P",24,0) . S SITEN=$$STA^XUAF4(SITE) "RTN","DG53856P",25,0) . I SITEN="200DOD" D "RTN","DG53856P",26,0) .. N FDA "RTN","DG53856P",27,0) .. I AA'="USDOD" S AA="USDOD",FDA(1,391.91,+TFIEN_",",10)=AA "RTN","DG53856P",28,0) .. I IDTYP'="NI" S IDTYP="NI",FDA(1,391.91,+TFIEN_",",.09)=IDTYP "RTN","DG53856P",29,0) .. I $D(FDA) D FILE^DIE("K","FDA(1)","ERR") "RTN","DG53856P",30,0) .. K FDA "RTN","DG53856P",31,0) . I SITEN["200N" D "RTN","DG53856P",32,0) .. N FDA "RTN","DG53856P",33,0) .. I IDTYP="" S IDTYP="NI" "RTN","DG53856P",34,0) .. I AA'="" S FDA(1,391.91,+TFIEN_",",.09)=IDTYP "RTN","DG53856P",35,0) .. I $D(FDA) D FILE^DIE("K","FDA(1)","ERR") "RTN","DG53856P",36,0) .. K FDA "RTN","DG53856P",37,0) . I AA'="",IDTYP'="",SITE'="",SID'="" D "RTN","DG53856P",38,0) .. S ^DGCN(391.91,"AISS",$E(SID,1,150),$E(AA,1,70),$E(IDTYP,1,10),$E(SITE,1,10),TFIEN)="" "RTN","DG53856P",39,0) Q "RTN","DG53856P",40,0) ; "RTN","DG53856P",41,0) RERUN ;If the AISS cross-reference must be deleted and recreated "RTN","DG53856P",42,0) ;by Product Support, use this line tag. "RTN","DG53856P",43,0) K ^DGCN(391.91,"AISS") "RTN","DG53856P",44,0) D AGN^DG53856P "RTN","DG53856P",45,0) Q "RTN","DG53856P",46,0) ; "RTN","VAFCTF") 0^5^B10514469^B10073625 "RTN","VAFCTF",1,0) VAFCTF ;BIR/DLR-Utility for capturing patient's Date Last Treated and Event Reason ;9/9/2002 "RTN","VAFCTF",2,0) ;;5.3;Registration;**428,713,766,856**;Aug 13, 1993;Build 5 "RTN","VAFCTF",3,0) Q ; quit if called from the top "RTN","VAFCTF",4,0) ; "RTN","VAFCTF",5,0) ;Reference to ^SCE("ADFN" supported by IA# 2953 "RTN","VAFCTF",6,0) ;Reference to EXC^RGHLLOG supported by IA# 2796 "RTN","VAFCTF",7,0) ;Reference to $$ICNLC^MPIF001 supported by IA #3072 "RTN","VAFCTF",8,0) ; "RTN","VAFCTF",9,0) EN1(VAFCDFN,VAFCSUP) ; determine the LAST TREATMENT DATE for a single "RTN","VAFCTF",10,0) ; patient "RTN","VAFCTF",11,0) ; input: VAFCDFN - the dfn of the patient "RTN","VAFCTF",12,0) ; VAFCSUP - if 1, suppress add entries to the ADT HL7 PIVOT "RTN","VAFCTF",13,0) ; (#391.71) file for TF messaging - VAFCTFMF (optional) "RTN","VAFCTF",14,0) ; output: VAFCDATE - patient's DATE LAST TREATED "RTN","VAFCTF",15,0) ; VAFCENVR - event reason "RTN","VAFCTF",16,0) ; "RTN","VAFCTF",17,0) N ERR,VAFCSITE,VAFCLAST,VAFCSITE,VAFCADMD,VAFCENDT,VAFCDATE,VAFCENVR,VAFCTYPE "RTN","VAFCTF",18,0) S U="^" "RTN","VAFCTF",19,0) S:'$D(VAFCSITE) VAFCSITE=$$KSP^XUPARAM("INST") ;defines the local facility "RTN","VAFCTF",20,0) S (VAFCLAST,VAFCADMD)=$$ADMDIS(VAFCDFN) ; dt_"^"_event type or "" "RTN","VAFCTF",21,0) S VAFCADMD=$S(VAFCADMD]"":$P(VAFCADMD,"^"),1:"") ; event dt or null "RTN","VAFCTF",22,0) S:$P(VAFCLAST,"^",2)=3!(VAFCLAST="") VAFCENDT=$$ENCDT(VAFCDFN,VAFCADMD) "RTN","VAFCTF",23,0) ; patient has been discharged or has never been admitted. Has this "RTN","VAFCTF",24,0) ; individual been checked out of a clinic? "RTN","VAFCTF",25,0) I $D(VAFCENDT)#2,($P(VAFCLAST,U)) S VAFCLAST=$S(+VAFCENDT>+VAFCLAST:VAFCENDT,1:VAFCLAST) "RTN","VAFCTF",26,0) I $D(VAFCENDT)#2,('$P(VAFCLAST,U)) S VAFCLAST=VAFCENDT "RTN","VAFCTF",27,0) S VAFCTYPE=$P(VAFCLAST,"^",2),VAFCDATE=+VAFCLAST "RTN","VAFCTF",28,0) ; input variables to FILE^VAFCTFU "RTN","VAFCTF",29,0) ; VAFCDFN - patient ien ; VAFCSITE - treating facility "RTN","VAFCTF",30,0) ; VAFCDATE - date last treated ; VAFCENVR - event reason "RTN","VAFCTF",31,0) ; "RTN","VAFCTF",32,0) I +VAFCDATE'>0 S VAFCDATE="",VAFCENVR="" "RTN","VAFCTF",33,0) I +VAFCDATE>0 S VAFCENVR=$S(VAFCTYPE=1:"A1",VAFCTYPE=3:"A2",1:"A3") ;A1=adm;A2=dis;A3=CO "RTN","VAFCTF",34,0) N STA,ICN S ICN=$$ICNLC^MPIF001(VAFCDFN),STA=$P($$SITE^VASITE,"^",3) "RTN","VAFCTF",35,0) ;**856 adding the new parameters to this FILE^VAFCTFU call "RTN","VAFCTF",36,0) ;FILE(PDFN,FSTRG,TICN,VAFCSLT,ERROR,IPP,SOURCEID,IDENSTAT,AA,IDTYP) "RTN","VAFCTF",37,0) D FILE^VAFCTFU(VAFCDFN,VAFCSITE_U_VAFCDATE_U_VAFCENVR,$G(VAFCSUP),1,.ERR,"",VAFCDFN,"A","USVHA","PI") I $D(ERR(STA)) D EXC^RGHLLOG(212,ERR(STA),VAFCDFN) "RTN","VAFCTF",38,0) ; "RTN","VAFCTF",39,0) Q "RTN","VAFCTF",40,0) ADMDIS(DFN) ; find the patient's last admission and discharge dates if "RTN","VAFCTF",41,0) ; they exist. "RTN","VAFCTF",42,0) ; Input: DFN - ien of the patient (file 2) "RTN","VAFCTF",43,0) ;Output: a valid discharge/admission date/time concatenated with "RTN","VAFCTF",44,0) ; the event type (1=admission, 3=discharge) -or- null "RTN","VAFCTF",45,0) N %,VAERR,VAIP S VAIP("D")="LAST" D IN5^VADPT "RTN","VAFCTF",46,0) I '+$G(VAIP(17,1)),('+$G(VAIP(13,1))) Q "" "RTN","VAFCTF",47,0) ; no discharge date, no admission date, return null "RTN","VAFCTF",48,0) I '+$G(VAIP(17,1)) Q $P($G(VAIP(13,1)),U)_"^1" "RTN","VAFCTF",49,0) ; no discharge date, return admission date "RTN","VAFCTF",50,0) I '+$G(VAIP(13,1)) Q $P($G(VAIP(17,1)),U)_"^3" "RTN","VAFCTF",51,0) ; no admission date, return discharge date "RTN","VAFCTF",52,0) I +$G(VAIP(17,1))>(+$G(VAIP(13,1))) Q +$G(VAIP(17,1))_"^3" "RTN","VAFCTF",53,0) ; return discharge date "RTN","VAFCTF",54,0) Q +$G(VAIP(13,1))_"^1" ; return admission date "RTN","VAFCTF",55,0) ; "RTN","VAFCTF",56,0) ENCDT(DFN,INPDT) ; find the last patient check out date/time. 'ADFN' "RTN","VAFCTF",57,0) ; cross-reference accessed through DBIA: 2953 "RTN","VAFCTF",58,0) ; Input: DFN - ien of the patient (file 2) "RTN","VAFCTF",59,0) ; INPDT - date (if any) returned from the inpatient admission/ "RTN","VAFCTF",60,0) ; discharge subroutine "RTN","VAFCTF",61,0) ;Output: a valid discharge/admission date/time concatenated with "RTN","VAFCTF",62,0) ; the event type (5=check out) -or- null "RTN","VAFCTF",63,0) Q:'DFN "" ; we need dfn defined "RTN","VAFCTF",64,0) N VAFCDATA,VAFCPURG,VAFCX,VAFCX1,VAFCX2,VAFCX3 "RTN","VAFCTF",65,0) S VAFCX=9999999.9999999,VAFCX2=0,VAFCX3="" "RTN","VAFCTF",66,0) F S VAFCX=$O(^SCE("ADFN",DFN,VAFCX),-1) Q:'VAFCX!(INPDT>VAFCX) D Q:VAFCX2 "RTN","VAFCTF",67,0) . S VAFCX1=0 F S VAFCX1=$O(^SCE("ADFN",DFN,VAFCX,VAFCX1)) Q:'VAFCX1 D Q:VAFCX2 "RTN","VAFCTF",68,0) .. D GETGEN^SDOE(VAFCX1,"VAFCDATA") "RTN","VAFCTF",69,0) .. D PARSE^SDOE(.VAFCDATA,"EXTERNAL","VAFCPARS") "RTN","VAFCTF",70,0) .. I $G(VAFCPARS(.12))="CHECKED OUT" S VAFCX2=1,VAFCX3=VAFCX "RTN","VAFCTF",71,0) .. K VAFCDATA,VAFCPARS "RTN","VAFCTF",72,0) .. Q "RTN","VAFCTF",73,0) . Q "RTN","VAFCTF",74,0) K VAFCDATA,VAFCPURG,VAFCX,VAFCX1,VAFCX2 "RTN","VAFCTF",75,0) ;DG*5.3*766 "RTN","VAFCTF",76,0) I $E(VAFCX3,9,10)>23 S VAFCX3=$E(VAFCX3,1,8)_"23"_$E(VAFCX3,11,14) "RTN","VAFCTF",77,0) I $E(VAFCX3,11)>5 S VAFCX3=$E(VAFCX3,1,10)_"59"_$E(VAFCX3,13,14) "RTN","VAFCTF",78,0) ;DG*5.3*713 "RTN","VAFCTF",79,0) I $E(VAFCX3,13)>5 S VAFCX3=$E(VAFCX3,1,12)_"59" "RTN","VAFCTF",80,0) Q VAFCX3_"^5" ; X is either null or the date/time of the check out "RTN","VAFCTF",81,0) ; "RTN","VAFCTFU") 0^3^B67856699^B65013803 "RTN","VAFCTFU",1,0) VAFCTFU ;ALB/JLU-UTILITIES FOR THE TREATING FACILITY FILE 391.91 ; 5/23/12 12:58pm "RTN","VAFCTFU",2,0) ;;5.3;Registration;**149,240,261,255,316,392,440,428,474,520,697,800,821,837,856**;Aug 13, 1993;Build 5 "RTN","VAFCTFU",3,0) ; "RTN","VAFCTFU",4,0) ;Reference to EXC^RGHLLOG and STOP^RGHLLOG supported by IA #2796 "RTN","VAFCTFU",5,0) ;Reference to $$UPDATE^ MPIFAPI supported by IA #2706 "RTN","VAFCTFU",6,0) ; "RTN","VAFCTFU",7,0) ;CHKSUB & GETSCN line tags removed, patch DG*5.3*697 "RTN","VAFCTFU",8,0) ;Subscriptions are no longer used and errors are being "RTN","VAFCTFU",9,0) ;generated when attempting to add a subscription. "RTN","VAFCTFU",10,0) ; "RTN","VAFCTFU",11,0) FILETF(PAT,INST) ;programmer entry point. "RTN","VAFCTFU",12,0) ;INPUT PAT - This is the patient's ICN "RTN","VAFCTFU",13,0) ; INST - This is the IEN of the institution or Treating Facility "RTN","VAFCTFU",14,0) ;it also contains the date of treatment in FM format. It is to be "RTN","VAFCTFU",15,0) ;stored in an array structure to allow for multiple treating "RTN","VAFCTFU",16,0) ;facilities. "RTN","VAFCTFU",17,0) ; EX. X(1)=500^2960101 "RTN","VAFCTFU",18,0) ; x(2)=425^2960202 "RTN","VAFCTFU",19,0) ; "RTN","VAFCTFU",20,0) ;OUTPUT 0 (ZERO) If no errors "RTN","VAFCTFU",21,0) ; 1^error description if there was an error. "RTN","VAFCTFU",22,0) ; "RTN","VAFCTFU",23,0) N PDFN,LP,VAFCER,X "RTN","VAFCTFU",24,0) S VAFCER=0 "RTN","VAFCTFU",25,0) I '$G(PAT)!('$D(INST)) S VAFCER="1^Parameter missing." G FILETFQ "RTN","VAFCTFU",26,0) I $D(@INST)<10 S VAFCER="1^Institution array not populated." G FILETFQ "RTN","VAFCTFU",27,0) S X="MPIF001" X ^%ZOSF("TEST") I '$T G FILETFQ "RTN","VAFCTFU",28,0) S PDFN=$$GETDFN^MPIF001(PAT) "RTN","VAFCTFU",29,0) I PDFN<0 S VAFCER="1^No patient DFN." G FILETFQ "RTN","VAFCTFU",30,0) N FSTRG "RTN","VAFCTFU",31,0) F LP=0:0 S LP=$O(@INST@(LP)) Q:'LP D FILE(PDFN,@INST@(LP)) "RTN","VAFCTFU",32,0) ; "RTN","VAFCTFU",33,0) FILETFQ Q VAFCER "RTN","VAFCTFU",34,0) ; "RTN","VAFCTFU",35,0) ; both the SET & QUERYTF subroutines have been moved to VAFCTFU1 as "RTN","VAFCTFU",36,0) ; the result of DG*5.3*261 *261 gjc@120899 "RTN","VAFCTFU",37,0) ; "RTN","VAFCTFU",38,0) FILE(PDFN,FSTRG,TICN,VAFCSLT,ERROR,IPP,SOURCEID,IDENSTAT,AA,IDTYP) ;this module files the individual entry "RTN","VAFCTFU",39,0) ;W KKKKK "RTN","VAFCTFU",40,0) ;PDFN is the patient's DFN "RTN","VAFCTFU",41,0) ;FSTRG = institution or treating facility^Date of treatment^Event reason "RTN","VAFCTFU",42,0) ;TICN - if 1 suppress add entries to ADT HL7 PIVOT (#391.71) file "RTN","VAFCTFU",43,0) ;VAFCSLT - (optional) if 1 suppress exception logging and return error in the ERROR array "RTN","VAFCTFU",44,0) ;ERROR - (optional) "RTN","VAFCTFU",45,0) ;Ex 500^2960202^A1 "RTN","VAFCTFU",46,0) ; "RTN","VAFCTFU",47,0) N X,Y,TMPFLG "RTN","VAFCTFU",48,0) I $G(VAFCSLT)="" S VAFCSLT=0 "RTN","VAFCTFU",49,0) S X="MPIF001" X ^%ZOSF("TEST") Q:'$T "RTN","VAFCTFU",50,0) S X="MPIFQ0" X ^%ZOSF("TEST") Q:'$T "RTN","VAFCTFU",51,0) N TFIEN,PDLT,FAC,EVNTR,VAFCER,CMOR,ICN,STA,ECNT "RTN","VAFCTFU",52,0) S ECNT=1 "RTN","VAFCTFU",53,0) S FAC=$P(FSTRG,U,1),PDLT=$P(FSTRG,U,2),EVNTR=$P(FSTRG,U,3) "RTN","VAFCTFU",54,0) S STA=$$STA^XUAF4(FAC) "RTN","VAFCTFU",55,0) ; "RTN","VAFCTFU",56,0) I '$$FIND1^DIC(4,"","MX","`"_FAC) D Q "RTN","VAFCTFU",57,0) . I 'VAFCSLT D EXC^RGHLLOG(212,"Msg#"_$G(HL("MID"))_" unknown Institution IEN "_FAC_" passed into TF update.",PDFN) D STOP^RGHLLOG(1) Q "RTN","VAFCTFU",58,0) . I VAFCSLT S ERROR(STA)="Update of "_STA_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to unknown Institution IEN "_FAC_" passed into TF update." "RTN","VAFCTFU",59,0) I PDLT'="" K %DT S %DT="T" S X=PDLT D ^%DT K %DT I Y<0 S VAFCER="1^Not a FM date." D Q "RTN","VAFCTFU",60,0) .I 'VAFCSLT D EXC^RGHLLOG(212,"TF updated in msg#"_$G(HL("MID"))_" for Institution IEN "_FAC_" but with invalid date "_PDLT_" for DFN "_PDFN,PDFN) "RTN","VAFCTFU",61,0) .I VAFCSLT S ERROR(STA)="Update of "_STA_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to invalid date "_PDLT_" for DFN "_PDFN "RTN","VAFCTFU",62,0) ;**856 - MVI 1371 (ckn) "RTN","VAFCTFU",63,0) ;Default assigning authority and Id type if not passed in as parameter "RTN","VAFCTFU",64,0) I $$GET1^DIQ(4,FAC_",",13,"E")'="OTHER" D "RTN","VAFCTFU",65,0) . I $G(AA)="" S AA="USVHA" "RTN","VAFCTFU",66,0) . I $G(IDTYP)="" S IDTYP="PI" "RTN","VAFCTFU",67,0) I $$STA^XUAF4(FAC)="200DOD" S AA="USDOD",IDTYP="NI" "RTN","VAFCTFU",68,0) ;Quit if incoming values are null for Source ID, AA, ID Type and Identifier Status. We do not want to create or update entry. "RTN","VAFCTFU",69,0) ;I $G(SOURCEID)="",$G(IDENSTAT)="",$G(AA)="",$G(IDTYP)="" Q "RTN","VAFCTFU",70,0) ;removed code for adding local ICN's "RTN","VAFCTFU",71,0) S ICN=+$$MPINODE^MPIFAPI(PDFN) "RTN","VAFCTFU",72,0) ;**837 - MVI_791 (ckn) - Loop through all existing entries for TF to decide to update or add after comparing incoming values. "RTN","VAFCTFU",73,0) ;S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,FAC,0)) D "RTN","VAFCTFU",74,0) S TMPFLG=0 "RTN","VAFCTFU",75,0) S TFIEN=0 F S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,FAC,TFIEN)) Q:+TFIEN=0!(TMPFLG) D "RTN","VAFCTFU",76,0) .;TFIEN is used in other places so quit after adding new entry "RTN","VAFCTFU",77,0) .;**837 - MVI_791 (ckn) "RTN","VAFCTFU",78,0) .I 'TFIEN Q "RTN","VAFCTFU",79,0) .N TMPAA,TMPIDTYP,TMPSID,TMPIDST "RTN","VAFCTFU",80,0) .;GET EXISTING FIELDS TO COMPARE WITH INCOMING VALUES "RTN","VAFCTFU",81,0) .S TMPAA=$P($G(^DGCN(391.91,TFIEN,2)),"^") ;Existing Assigning Authority "RTN","VAFCTFU",82,0) .S TMPIDTYP=$P($G(^DGCN(391.91,TFIEN,0)),"^",9) ;Existing IDtype "RTN","VAFCTFU",83,0) .S TMPSID=$P($G(^DGCN(391.91,TFIEN,2)),"^",2) ;Existing Source ID "RTN","VAFCTFU",84,0) .S TMPIDST=$P($G(^DGCN(391.91,TFIEN,2)),"^",3) ;Existing Identifier Status "RTN","VAFCTFU",85,0) .;NOW COMPARE INCOMING FIELDS AND EXISTING FIELDS TO DETERMINE UNIQUE ENTRY "RTN","VAFCTFU",86,0) .I TMPAA=$G(AA),TMPIDTYP=$G(IDTYP),TMPSID=$G(SOURCEID),TMPIDST=$G(IDENSTAT) S TMPFLG=1 "RTN","VAFCTFU",87,0) .I TMPFLG D FILEDIT(TFIEN,PDLT,PDFN,FAC,EVNTR,VAFCSLT,.ERROR,$G(IPP),$G(SOURCEID),$G(IDENSTAT),$G(AA),$G(IDTYP)) "RTN","VAFCTFU",88,0) I 'TMPFLG D FILENEW(PDFN,FAC,PDLT,EVNTR,VAFCSLT,.ERROR,$G(IPP),$G(SOURCEID),$G(IDENSTAT),$G(AA),$G(IDTYP)) Q "RTN","VAFCTFU",89,0) ;look to see if CMOR is in TF list if not add "RTN","VAFCTFU",90,0) ;S CMOR=$$GETVCCI^MPIF001(PDFN) "RTN","VAFCTFU",91,0) ;S CMOR=$$LKUP^XUAF4(CMOR) ; **520 REMOVED + "RTN","VAFCTFU",92,0) ;check to see if CMOR exist if not add it "RTN","VAFCTFU",93,0) ;MVI-791 (ckn) - no need to check for CMOR and add new "RTN","VAFCTFU",94,0) ;I +$G(CMOR)>0 D:'$D(^DGCN(391.91,"APAT",PDFN,CMOR)) FILENEW^VAFCTFU(PDFN,CMOR) "RTN","VAFCTFU",95,0) ;create the entry in the pivot to broadcast the MFU. "RTN","VAFCTFU",96,0) ; Note: we will not broadcast to the MFU if the TFL record "RTN","VAFCTFU",97,0) ; has an event reason. See comments in FILEDIT. *261 gjc@120199 "RTN","VAFCTFU",98,0) I $G(TICN)'=1,$P($$SEND^VAFHUTL,"^",2)>0 D SETSND(PDFN) "RTN","VAFCTFU",99,0) FILEQ Q "RTN","VAFCTFU",100,0) ; "RTN","VAFCTFU",101,0) FILENEW(PDFN,FAC,PDLT,EVNTR,VAFCSLT,ERROR,IPP,SOURCEID,IDENSTAT,AA,IDTYP) ; "RTN","VAFCTFU",102,0) N DGSENFLG ;**240 added y "RTN","VAFCTFU",103,0) K DD,DO,DIC,DA,RESULT "RTN","VAFCTFU",104,0) S DGSENFLG="" "RTN","VAFCTFU",105,0) N FDA,FDAIEN,ERR S ERR="" "RTN","VAFCTFU",106,0) I $G(EVNTR)'="" D CHK^DIE(391.91,.07,"",EVNTR,.RESULT) I +RESULT>0 S EVNTR=RESULT "RTN","VAFCTFU",107,0) S FDA(1,391.91,"+1,",.01)=PDFN "RTN","VAFCTFU",108,0) S FDA(1,391.91,"+1,",.02)=FAC "RTN","VAFCTFU",109,0) S FDA(1,391.91,"+1,",.03)=$G(PDLT) "RTN","VAFCTFU",110,0) S FDA(1,391.91,"+1,",.07)=$G(EVNTR) "RTN","VAFCTFU",111,0) S FDA(1,391.91,"+1,",.08)=$G(IPP) "RTN","VAFCTFU",112,0) ;**837 - MVI_791 (ckn) "RTN","VAFCTFU",113,0) S FDA(1,391.91,"+1,",10)=$G(AA) ;Assigning Authority "RTN","VAFCTFU",114,0) S FDA(1,391.91,"+1,",.09)=$G(IDTYP) ;Source Id Type "RTN","VAFCTFU",115,0) S FDA(1,391.91,"+1,",11)=$G(SOURCEID) ;Source ID "RTN","VAFCTFU",116,0) S FDA(1,391.91,"+1,",12)=$G(IDENSTAT) ;Identifier Status "RTN","VAFCTFU",117,0) L +^DGCN(391.91,0):30 "RTN","VAFCTFU",118,0) D UPDATE^DIE("","FDA(1)","FDAIEN","ERR") I $D(ERR("DIERR",1)) S ERROR(STA)="Add of "_STA_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to "_$G(ERR("DIERR",1,"TEXT",1)) "RTN","VAFCTFU",119,0) ;**837 (ckn) - MVI_791 - No more Source ID multiple "RTN","VAFCTFU",120,0) ;I $G(SOURCEID)'="",$G(FDAIEN(1))'="" D UPDSID(PDFN,FAC,SOURCEID,IDENSTAT,FDAIEN(1)) ;Update SourceID multiple "RTN","VAFCTFU",121,0) ;removed code to add a subscription "RTN","VAFCTFU",122,0) L -^DGCN(391.91,0) "RTN","VAFCTFU",123,0) K DIC,DD,DO,DA "RTN","VAFCTFU",124,0) Q "RTN","VAFCTFU",125,0) ; "RTN","VAFCTFU",126,0) UPDSID(PDFN,FAC,SID,IDSTAT,TFIEN) ;Update sourceid multiple "RTN","VAFCTFU",127,0) N FDA,DGENDA,FILE,IENS "RTN","VAFCTFU",128,0) S FILE=391.9101 "RTN","VAFCTFU",129,0) I $D(^DGCN(391.91,TFIEN,1,"B",SID)) D Q ;Update existing sub record "RTN","VAFCTFU",130,0) . S DGENDA=$O(^DGCN(391.91,TFIEN,1,"B",SID,0)) "RTN","VAFCTFU",131,0) . S DGENDA(1)=TFIEN,IENS=$$IENS^DILF(.DGENDA) "RTN","VAFCTFU",132,0) . S FDA(FILE,IENS,.01)=SID,FDA(FILE,IENS,1)=IDSTAT "RTN","VAFCTFU",133,0) . D FILE^DIE("K","FDA","ERRORS(1)") "RTN","VAFCTFU",134,0) ;add new sub record "RTN","VAFCTFU",135,0) S DGENDA="+1",DGENDA(1)=TFIEN,IENS=$$IENS^DILF(.DGENDA) "RTN","VAFCTFU",136,0) S FDA(FILE,IENS,.01)=SID,FDA(FILE,IENS,1)=IDSTAT "RTN","VAFCTFU",137,0) D UPDATE^DIE("","FDA","IENA","ERRORS(1)") "RTN","VAFCTFU",138,0) Q "RTN","VAFCTFU",139,0) SETSND(PDFN) ;sets the pivot file entry to send MFU "RTN","VAFCTFU",140,0) ; "RTN","VAFCTFU",141,0) N ANS,X "RTN","VAFCTFU",142,0) S X="MPIF001" X ^%ZOSF("TEST") Q:'$T "RTN","VAFCTFU",143,0) ; check if other facilities other than CMOR in TF list "RTN","VAFCTFU",144,0) N SIT,CMOR,STOP "RTN","VAFCTFU",145,0) S CMOR=$$GETVCCI^MPIF001(PDFN) "RTN","VAFCTFU",146,0) S CMOR=$$LKUP^XUAF4(CMOR) ; **520 REMOVED + "RTN","VAFCTFU",147,0) I CMOR=$P($$SITE^VASITE,"^") D "RTN","VAFCTFU",148,0) .S SIT=0 "RTN","VAFCTFU",149,0) .S SIT=$O(^DGCN(391.91,"APAT",PDFN,SIT)) "RTN","VAFCTFU",150,0) .I SIT=CMOR S SIT=$O(^DGCN(391.91,"APAT",PDFN,SIT)) I SIT="" S STOP="" "RTN","VAFCTFU",151,0) I $D(STOP) QUIT "RTN","VAFCTFU",152,0) S ANS=$$PIVNW^VAFHPIVT(PDFN,DT,5,PDFN_";DPT(") "RTN","VAFCTFU",153,0) I 'ANS QUIT "RTN","VAFCTFU",154,0) D XMITFLAG^VAFCDD01(0,+ANS,0) "RTN","VAFCTFU",155,0) SETSNDQ Q "RTN","VAFCTFU",156,0) ; "RTN","VAFCTFU",157,0) FILEDIT(TFIEN,PDLT,PDFN,FAC,EVNTR,VAFCSLT,ERROR,IPP,SOURCEID,IDENSTAT,AA,IDTYP) ; "RTN","VAFCTFU",158,0) N DGSENFLG,FDA,FDAIEN,ERR,RESULT S DGSENFLG="",ERR="" "RTN","VAFCTFU",159,0) I $G(PDLT)'=""!($G(IPP)'="")!($G(AA)'="")!($G(IDTYP)'="")!($G(SOURCEID)'="")!($G(IDENSTAT)'="") D "RTN","VAFCTFU",160,0) .S TFIEN(0)=$G(^DGCN(391.91,TFIEN,0)) "RTN","VAFCTFU",161,0) .I $G(EVNTR)'="" D CHK^DIE(391.91,.07,"",EVNTR,.RESULT) I +RESULT>0 S EVNTR=RESULT "RTN","VAFCTFU",162,0) .I $G(PDLT)'="" S FDA(1,391.91,+TFIEN_",",.03)=$G(PDLT) "RTN","VAFCTFU",163,0) .S FDA(1,391.91,+TFIEN_",",.07)=$G(EVNTR) "RTN","VAFCTFU",164,0) .I $G(IPP)'="" S FDA(1,391.91,+TFIEN_",",.08)=$G(IPP) "RTN","VAFCTFU",165,0) .;**837 - MVI_791 (ckn) "RTN","VAFCTFU",166,0) .I $G(AA)'="" S FDA(1,391.91,+TFIEN_",",10)=$G(AA) "RTN","VAFCTFU",167,0) .I $G(IDTYP)'="" S FDA(1,391.91,+TFIEN_",",.09)=$G(IDTYP) "RTN","VAFCTFU",168,0) .I $G(SOURCEID)'="" S FDA(1,391.91,+TFIEN_",",11)=$G(SOURCEID) "RTN","VAFCTFU",169,0) .I $G(IDENSTAT)'="" S FDA(1,391.91,+TFIEN_",",12)=$G(IDENSTAT) "RTN","VAFCTFU",170,0) .D FILE^DIE("K","FDA(1)","ERR") I VAFCSLT I $D(ERR("DIERR",1)) S ERROR(STA)="Edit of "_STA_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to "_$G(ERR("DIERR",1,"TEXT",1)) "RTN","VAFCTFU",171,0) ;**837 - MVI_791 (ckn) - no more updates to multiples "RTN","VAFCTFU",172,0) ;I $G(SOURCEID)'="" D UPDSID(PDFN,FAC,SOURCEID,IDENSTAT,TFIEN) "RTN","VAFCTFU",173,0) ;remove code to add a subscription "RTN","VAFCTFU",174,0) Q "RTN","VAFCTFU",175,0) ; "RTN","VAFCTFU",176,0) DELETETF(PAT,INST,DTIEN) ;deletion entry point "RTN","VAFCTFU",177,0) ;This entry point is used to delete a single Treating Facility from "RTN","VAFCTFU",178,0) ;the Treating Facility list. "RTN","VAFCTFU",179,0) ;**837 - MVI_791 (ckn) - Now we will have multiple entries in TF file so it is determined which entry to be deleted before calling this api. Hence, Treating Facility IEN is passed in. Unused code is commented out. "RTN","VAFCTFU",180,0) ;INPUT PAT - the ICN of the patient. "RTN","VAFCTFU",181,0) ; INST - the IEN of the institution to be deleted. "RTN","VAFCTFU",182,0) ; DTIEN - the IEN of Treating Facility file "RTN","VAFCTFU",183,0) ;OUTPUT 0 (zero) - If no errors "RTN","VAFCTFU",184,0) ; 1^error description if there was a problem "RTN","VAFCTFU",185,0) ; "RTN","VAFCTFU",186,0) ;**837 v4 MVI 791 (ckn) - check if DTIEN is passed "RTN","VAFCTFU",187,0) I $G(DTIEN)="" Q "-1^DTIEN - IEN of Treating Facility not defined" "RTN","VAFCTFU",188,0) N VAFCER,PDFN,TFIEN,X,VAFCSCN,LINK,VAFCLLN,IEN "RTN","VAFCTFU",189,0) S VAFCER=0 "RTN","VAFCTFU",190,0) I '$G(PAT)!('$G(INST)) S VAFCER="1^Parameter missing." S ERROR(INST)="212"_"^"_$G(HL("MID"))_"^"_"Delete Failed: "_$P(VAFCER,"^") G DELTFQ "RTN","VAFCTFU",191,0) S X="MPIF001" X ^%ZOSF("TEST") I '$T G FILETFQ "RTN","VAFCTFU",192,0) S PDFN=$$GETDFN^MPIF001(+PAT) "RTN","VAFCTFU",193,0) I PDFN<0 S VAFCER="1^No patient DFN." G FILETFQ "RTN","VAFCTFU",194,0) I '$$FIND1^DIC(4,"","MX","`"_INST) S VAFCER="1^Not an Institution IEN." G DELTFQ "RTN","VAFCTFU",195,0) I '$D(^DGCN(391.91,DTIEN)) S VAFCER="1^Could not find Treating Facility." G DELTFQ "RTN","VAFCTFU",196,0) D DELETE(DTIEN) "RTN","VAFCTFU",197,0) I $D(^DGCN(391.91,DTIEN)) S VAFCER="1^DIK failed to delete entry" G DELTFQ "RTN","VAFCTFU",198,0) ;terminate the subscription if there is one "RTN","VAFCTFU",199,0) S VAFCSCN=+$P($$MPINODE^MPIFAPI(PDFN),"^",5) I +$G(VAFCSCN)>0 D "RTN","VAFCTFU",200,0) .;get logical link "RTN","VAFCTFU",201,0) . D LINK^HLUTIL3(INST,.LINK) S VAFCLLN=$O(LINK(0)) I +$G(VAFCLLN)>0 S VAFCLLN=LINK(VAFCLLN) D UPD^HLSUB(VAFCSCN,VAFCLLN,0,,$$NOW^XLFDT,,.HLER) "RTN","VAFCTFU",202,0) ;**837 - MVI_791 (ckn) - no need to retire pdr anymore as it is not used "RTN","VAFCTFU",203,0) ;D RETPDR^VAFCEHU2(PDFN,INST) ;**474 retire pdr when deleting tf "RTN","VAFCTFU",204,0) DELTFQ Q VAFCER "RTN","VAFCTFU",205,0) ; "RTN","VAFCTFU",206,0) DELETE(TFIEN) ;the actual deletion code "RTN","VAFCTFU",207,0) ; "RTN","VAFCTFU",208,0) K DIK,DA "RTN","VAFCTFU",209,0) S DIK="^DGCN(391.91," "RTN","VAFCTFU",210,0) S DA=TFIEN "RTN","VAFCTFU",211,0) D ^DIK K DIK,DA "RTN","VAFCTFU",212,0) Q "RTN","VAFCTFU",213,0) ; "RTN","VAFCTFU",214,0) DELALLTF(PAT) ;Entry point to delete all Treating Facilities for a single "RTN","VAFCTFU",215,0) ;patient. "RTN","VAFCTFU",216,0) ;INPUT PAT - The patient's ICN "RTN","VAFCTFU",217,0) ;OUTPUT 0 (zero) - If no errors "RTN","VAFCTFU",218,0) ; 1^error description if an error "RTN","VAFCTFU",219,0) ; "RTN","VAFCTFU",220,0) N VAFCER,PDFN,LP,TFIEN,X "RTN","VAFCTFU",221,0) S VAFCER=0 "RTN","VAFCTFU",222,0) I '$G(PAT) Q "1^Parameter missing." "RTN","VAFCTFU",223,0) S X="MPIF001" X ^%ZOSF("TEST") I '$T Q 0 "RTN","VAFCTFU",224,0) S PDFN=$$GETDFN^MPIF001(PAT) "RTN","VAFCTFU",225,0) I PDFN<0 Q "1^No patient DFN." "RTN","VAFCTFU",226,0) F LP=0:0 S LP=$O(^DGCN(391.91,"APAT",PDFN,LP)) Q:LP'>0 D "RTN","VAFCTFU",227,0) . S TFIEN=0 "RTN","VAFCTFU",228,0) . F S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,LP,TFIEN)) Q:TFIEN'>0 D DELETE(TFIEN) "RTN","VAFCTFU",229,0) ; "RTN","VAFCTFU",230,0) Q VAFCER "RTN","VAFCTFU",231,0) ; "RTN","VAFCTFU1") 0^4^B11999906^B9951191 "RTN","VAFCTFU1",1,0) VAFCTFU1 ;BHM/RGY-Utilities for the Treating Facility file 391.91, CONTINUED ; 5/23/12 12:51pm "RTN","VAFCTFU1",2,0) ;;5.3;Registration;**261,392,448,449,800,856**;Aug 13, 1993;Build 5 "RTN","VAFCTFU1",3,0) TFL(LIST,DFN) ;for dfn get list of treating facilities "RTN","VAFCTFU1",4,0) NEW X,ICN,DA,DR,VAFCTFU1,DIC,DIQ,VAFC "RTN","VAFCTFU1",5,0) S X="MPIF001" X ^%ZOSF("TEST") I '$T S LIST(1)="-1^MPI Not Installed" Q "RTN","VAFCTFU1",6,0) S DR=".01;13;99",DIC=4,DIQ(0)="E",DIQ="VAFCTFU1" ;**448 "RTN","VAFCTFU1",7,0) S ICN=$$GETICN^MPIF001(DFN) "RTN","VAFCTFU1",8,0) I ICN<0 S LIST(1)=ICN Q "RTN","VAFCTFU1",9,0) S X=$$QUERYTF($P(ICN,"V"),"LIST",0) "RTN","VAFCTFU1",10,0) I $P(X,U)="1" S LIST(1)="-1"_U_$P(X,U,2) Q "RTN","VAFCTFU1",11,0) F VAFC=0:0 S VAFC=$O(LIST(VAFC)) Q:VAFC="" D "RTN","VAFCTFU1",12,0) .K VAFCTFU1 "RTN","VAFCTFU1",13,0) .S DA=+LIST(VAFC) "RTN","VAFCTFU1",14,0) .D EN^DIQ1 "RTN","VAFCTFU1",15,0) .S LIST(VAFC)=VAFCTFU1(4,+LIST(VAFC),99,"E")_"^"_VAFCTFU1(4,+LIST(VAFC),.01,"E")_"^"_$P(LIST(VAFC),"^",2)_"^"_$P(LIST(VAFC),"^",3)_"^"_VAFCTFU1(4,+LIST(VAFC),13,"E") ;**448 "RTN","VAFCTFU1",16,0) .Q "RTN","VAFCTFU1",17,0) Q "RTN","VAFCTFU1",18,0) GETICN(RESULT,DFN) ; "RTN","VAFCTFU1",19,0) S RESULT=$$GETICN^MPIF001(DFN) "RTN","VAFCTFU1",20,0) Q "RTN","VAFCTFU1",21,0) GETDFN(RESULT,ICN) ; "RTN","VAFCTFU1",22,0) S RESULT=$$GETDFN^MPIF001(ICN) "RTN","VAFCTFU1",23,0) Q "RTN","VAFCTFU1",24,0) IFLOCAL(RESULT,DFN) ; "RTN","VAFCTFU1",25,0) S RESULT=$$IFLOCAL^MPIF001(DFN) "RTN","VAFCTFU1",26,0) Q "RTN","VAFCTFU1",27,0) ; "RTN","VAFCTFU1",28,0) SET(TFIEN,ARY,CTR) ;This sets the array with the treating facility list. "RTN","VAFCTFU1",29,0) ; Returns: treating facility ^ treatment date ^ event reason (if any) "RTN","VAFCTFU1",30,0) ; *261 gjc@120899 (formerly part of VAFCTFU prior to DG*5.3*261) "RTN","VAFCTFU1",31,0) N DGCN,INSTIEN,LSTA S DGCN(0)=$G(^DGCN(391.91,TFIEN,0)) "RTN","VAFCTFU1",32,0) ;** DG*5.3*800 - (ckn) - Quit if IPP field is not set for 200MH record "RTN","VAFCTFU1",33,0) S INSTIEN=$P($G(DGCN(0)),"^",2),LSTA=$$STA^XUAF4(INSTIEN) "RTN","VAFCTFU1",34,0) I $E(LSTA,1,5)="200MH",$P($G(DGCN(0)),"^",8)'=1 Q "RTN","VAFCTFU1",35,0) S CTR=CTR+1,@ARY@(CTR)=$P(DGCN(0),U,2,3)_U_$P(DGCN(0),U,7) "RTN","VAFCTFU1",36,0) Q "RTN","VAFCTFU1",37,0) ; "RTN","VAFCTFU1",38,0) QUERYTF(PAT,ARY,INDX) ;a query for Treating Facility. "RTN","VAFCTFU1",39,0) ;INPUT PAT - The patient's ICN "RTN","VAFCTFU1",40,0) ; ARY - The array in which to return the Treating facility info. "RTN","VAFCTFU1",41,0) ; INDX (optional) - the index to $O through. APAT for patient "RTN","VAFCTFU1",42,0) ; information linked to treating facilities, AEVN for patient "RTN","VAFCTFU1",43,0) ; info linked with an event reason. INDX=1 if AEVN is used, "RTN","VAFCTFU1",44,0) ; else APAT is used. *261 gjc@120399 "RTN","VAFCTFU1",45,0) ; "RTN","VAFCTFU1",46,0) ;OUTPUT A list of the Treating Facilities in the array provided from "RTN","VAFCTFU1",47,0) ; the parameter. It will be in the structure of x(1), x(2) etc. "RTN","VAFCTFU1",48,0) ; Ex X(1)=500^2960101^ptr to ADT/HL7 Event Reason file (if exists) "RTN","VAFCTFU1",49,0) ; Where the first piece is the IEN of the institution, the second "RTN","VAFCTFU1",50,0) ; piece is the current date on record for that institution and the "RTN","VAFCTFU1",51,0) ; third piece is the event reason (if it exists). Note: A04 & A08 "RTN","VAFCTFU1",52,0) ; events do not file an event reason when adding to the TREATING "RTN","VAFCTFU1",53,0) ; FACILITY LIST (#391.91) file, thus returning null in the third "RTN","VAFCTFU1",54,0) ; piece. *261 gjc@120199 "RTN","VAFCTFU1",55,0) ; "RTN","VAFCTFU1",56,0) ; This is also a function call. If there is an error then a "RTN","VAFCTFU1",57,0) ; 1^error description will be returned. "RTN","VAFCTFU1",58,0) ; "RTN","VAFCTFU1",59,0) ; *** If no data is found the array will not be populated and "RTN","VAFCTFU1",60,0) ; a 1^error description will be returned. "RTN","VAFCTFU1",61,0) ; "RTN","VAFCTFU1",62,0) N PDFN,VAFCER,LP,CTR,ZTFIEN,ZDLT,ZTDLT "RTN","VAFCTFU1",63,0) I '$G(PAT)!('$D(ARY)) S VAFCER="1^Parameter missing." G QUERYTFQ "RTN","VAFCTFU1",64,0) S VAFCER=0,CTR=0,INDX=$G(INDX) "RTN","VAFCTFU1",65,0) S X="MPIF001" X ^%ZOSF("TEST") I '$T G QUERYTFQ "RTN","VAFCTFU1",66,0) S PDFN=$$GETDFN^MPIF001(PAT) "RTN","VAFCTFU1",67,0) I PDFN<0 S VAFCER="1^No patient DFN." G QUERYTFQ "RTN","VAFCTFU1",68,0) ; determine the index to $O through, based on the value of INDX "RTN","VAFCTFU1",69,0) ;I 'INDX F LP=0:0 S LP=$O(^DGCN(391.91,"APAT",PDFN,LP)) Q:'LP S TFIEN=$O(^(LP,"")) D SET(TFIEN,ARY,.CTR) "RTN","VAFCTFU1",70,0) ;**856 - MVI 1371 (ckn) "RTN","VAFCTFU1",71,0) ;Now that Treating Facility file can have multiple entries for "RTN","VAFCTFU1",72,0) ;one site, enhanced the code to loop through all TFIENs for each SITE "RTN","VAFCTFU1",73,0) ;and return the record which have latest Date Last Treated. If none "RTN","VAFCTFU1",74,0) ;of the entries have DLT populated, return the first record for site. "RTN","VAFCTFU1",75,0) I 'INDX F LP=0:0 S LP=$O(^DGCN(391.91,"APAT",PDFN,LP)) Q:'LP D "RTN","VAFCTFU1",76,0) .S ZTDLT=0,ZTFIEN=$O(^DGCN(391.91,"APAT",PDFN,LP,"")) Q:'ZTFIEN "RTN","VAFCTFU1",77,0) .S TFIEN=0 F S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,LP,TFIEN)) Q:'TFIEN D "RTN","VAFCTFU1",78,0) ..S ZDLT=$P(^DGCN(391.91,TFIEN,0),"^",3) ;Date last treated "RTN","VAFCTFU1",79,0) ..I ZDLT>ZTDLT S ZTDLT=ZDLT,ZTFIEN=TFIEN "RTN","VAFCTFU1",80,0) .D SET(ZTFIEN,ARY,.CTR) "RTN","VAFCTFU1",81,0) I INDX S LP=0 F S LP=$O(^DGCN(391.91,"AEVN",PDFN,LP)) Q:'LP D "RTN","VAFCTFU1",82,0) .; please note the following: the AEVN xref is subscripted by pat. dfn "RTN","VAFCTFU1",83,0) .; event reason ptr, and the ien of the TFL file. It is possible "RTN","VAFCTFU1",84,0) .; that a patient may have numerous admission/discharges at different "RTN","VAFCTFU1",85,0) .; treating facilities, thus the looping through the TFIEN (TFL ien) "RTN","VAFCTFU1",86,0) .; subscript. *261 gjc@120399 "RTN","VAFCTFU1",87,0) .S TFIEN=0 F S TFIEN=$O(^DGCN(391.91,"AEVN",PDFN,LP,TFIEN)) Q:'TFIEN D SET(TFIEN,ARY,.CTR) "RTN","VAFCTFU1",88,0) .Q "RTN","VAFCTFU1",89,0) I $D(@ARY)'>9 S VAFCER="1^Could not find Treating Facilities" "RTN","VAFCTFU1",90,0) QUERYTFQ Q VAFCER "RTN","VAFCTFU2") 0^1^B47326411^B41375332 "RTN","VAFCTFU2",1,0) VAFCTFU2 ;BHM/CMC,CKN-Utilities for the Treating Facility file 391.91, CONTINUED ; 5/23/12 6:25pm "RTN","VAFCTFU2",2,0) ;;5.3;Registration;**821,856**;Aug 13, 1993;Build 5 "RTN","VAFCTFU2",3,0) TFL(LIST,PT) ;for this PT [patient] (either DFN, ICN or EDIPI) return the list of treating facilities "RTN","VAFCTFU2",4,0) ; CALLED FROM RPC VAFC LOCAL GET CORRESPONDINGIDS "RTN","VAFCTFU2",5,0) ; PT values --> "RTN","VAFCTFU2",6,0) ;ICN example: 1008520438V882204^NI^USVHA^200M "RTN","VAFCTFU2",7,0) ;DFN example: 100000511^PI^USVHA^500 "RTN","VAFCTFU2",8,0) ;EDIPI example: 852043888^NI^USDOD^200DOD "RTN","VAFCTFU2",9,0) ; "RTN","VAFCTFU2",10,0) ; Return: "RTN","VAFCTFU2",11,0) ; This will return the ICN and the list of treating facilities in the following. "RTN","VAFCTFU2",12,0) ; "RTN","VAFCTFU2",13,0) ; format: "RTN","VAFCTFU2",14,0) ; Id^IdType^AssigningAuthority^AssigningFacility^IdStatus "RTN","VAFCTFU2",15,0) ; "RTN","VAFCTFU2",16,0) ; Examples: "RTN","VAFCTFU2",17,0) ; RESULT(1)="1011232151V598646^NI^200M^A" "RTN","VAFCTFU2",18,0) ; RESULT(2)="7168937^PI^USVHA^500^A" "RTN","VAFCTFU2",19,0) ; RESULT(3)="852043888^NI^USDOD^200DOD^A" "RTN","VAFCTFU2",20,0) ; "RTN","VAFCTFU2",21,0) N X,ICN,DA,DR,VAFCTFU1,DIC,DIQ,VAFC,DFN,EDIPI,ASSIGN,ID,SITE,TYPE "RTN","VAFCTFU2",22,0) S X="MPIF001" X ^%ZOSF("TEST") I '$T S LIST(1)="-1^MPI Not Installed" Q "RTN","VAFCTFU2",23,0) ; clear "return" variable "RTN","VAFCTFU2",24,0) K LIST "RTN","VAFCTFU2",25,0) ; what do we have "RTN","VAFCTFU2",26,0) S TYPE=$P(PT,"^",2),SITE=$P(PT,"^",4),ID=$P(PT,"^"),ASSIGN=$P(PT,"^",3) "RTN","VAFCTFU2",27,0) ; check input data "RTN","VAFCTFU2",28,0) I ID']"" S LIST(1)="-1^Id is not defined." Q "RTN","VAFCTFU2",29,0) I TYPE'="NI",TYPE'="PI" S LIST(1)="-1^Invalid Id Type." Q "RTN","VAFCTFU2",30,0) I ASSIGN'="USVHA",ASSIGN'="USDOD" S LIST(1)="-1^Invalid Assigning Authority." Q "RTN","VAFCTFU2",31,0) I SITE']"" S LIST(1)="-1^Missing Assigning Facility." Q "RTN","VAFCTFU2",32,0) ; find the ien for the station number "RTN","VAFCTFU2",33,0) S SITEIEN=$O(^DIC(4,"D",SITE,0)) "RTN","VAFCTFU2",34,0) I 'SITEIEN S LIST(1)="-1^Assigning Facility is not defined in database." Q "RTN","VAFCTFU2",35,0) ; "RTN","VAFCTFU2",36,0) I TYPE="PI",ASSIGN="USVHA" S DFN=ID "RTN","VAFCTFU2",37,0) I TYPE="NI",ASSIGN="USVHA",SITE="200M" S ICN=ID "RTN","VAFCTFU2",38,0) I TYPE="NI",ASSIGN="USDOD",SITE="200DOD" S EDIPI=ID "RTN","VAFCTFU2",39,0) I $D(ICN) S DFN=$$GETDFN^MPIF001(ICN) D Q:$D(LIST(1)) "RTN","VAFCTFU2",40,0) . I +DFN<0 S LIST(1)="-1^ICN is not known" Q "RTN","VAFCTFU2",41,0) . S SITEIEN=$$IEN^XUAF4($P($$SITE^VASITE,"^",3)) "RTN","VAFCTFU2",42,0) ; "RTN","VAFCTFU2",43,0) I $D(DFN) S ICN=$$GETICN^MPIF001(DFN) "RTN","VAFCTFU2",44,0) ; DFN should be defined, but ICN may not. "RTN","VAFCTFU2",45,0) ; I $D(EDIPI) S ICN=$$GETICN(EDIPI) "RTN","VAFCTFU2",46,0) ; check EDIPI "RTN","VAFCTFU2",47,0) ;I $D(EDIPI),'$D(^DGCN(391.91,"ASCR",EDIPI,SITEIEN)) D Q "RTN","VAFCTFU2",48,0) ;. S LIST(1)="-1^EDIPI Record is unknown at this facility" "RTN","VAFCTFU2",49,0) ;I $D(EDIPI),$D(^DGCN(391.91,"ASCR",EDIPI,SITEIEN)) D "RTN","VAFCTFU2",50,0) ;.S EN=$O(^DGCN(391.91,"ASCR",EDIPI,SITEIEN,0)) "RTN","VAFCTFU2",51,0) ;.S DFN=$P($G(^DGCN(391.91,EN,0)),"^") "RTN","VAFCTFU2",52,0) ;**856 MVI 1371 (ckn) "RTN","VAFCTFU2",53,0) ;Use new xref AISS appropriately to retrieve DFN from EDIPI "RTN","VAFCTFU2",54,0) I $D(EDIPI)=""!(ASSIGN="")!(TYPE="")!(SITEIEN="") S LIST(1)="-1^Insufficient data" Q "RTN","VAFCTFU2",55,0) I $D(EDIPI),'$D(^DGCN(391.91,"AISS",EDIPI,ASSIGN,TYPE,SITEIEN)) D Q "RTN","VAFCTFU2",56,0) . S LIST(1)="-1^EDIPI Record is unknown at this facility" "RTN","VAFCTFU2",57,0) I $D(EDIPI),$D(^DGCN(391.91,"AISS",EDIPI,ASSIGN,TYPE,SITEIEN)) D "RTN","VAFCTFU2",58,0) .S EN=$O(^DGCN(391.91,"AISS",EDIPI,ASSIGN,TYPE,SITEIEN,0)) "RTN","VAFCTFU2",59,0) .S DFN=$P($G(^DGCN(391.91,EN,0)),"^") "RTN","VAFCTFU2",60,0) ; "RTN","VAFCTFU2",61,0) ; if ICN is not defined, it is OK, but DFN should be defined "RTN","VAFCTFU2",62,0) ; I $G(ICN)<0 S LIST(1)=ICN Q "RTN","VAFCTFU2",63,0) ; bad input, such as Id^NI^USVHA^123 "RTN","VAFCTFU2",64,0) I '$G(DFN) S LIST(1)="-1^Invalid input" Q "RTN","VAFCTFU2",65,0) ; check DFN and Site to be matching an entry in file #391.91 "RTN","VAFCTFU2",66,0) I '$O(^DGCN(391.91,"APAT",DFN,SITEIEN,0)) D Q "RTN","VAFCTFU2",67,0) . S LIST(1)="-1^Id as '"_ID_"'"_" is not in database" "RTN","VAFCTFU2",68,0) ; DFN should be defined, but ICN may not. "RTN","VAFCTFU2",69,0) S X=$$QUERYTF($P($G(ICN),"V"),"LIST") "RTN","VAFCTFU2",70,0) I $P(X,U)="1" S LIST(1)="-1"_U_$P(X,U,2) Q "RTN","VAFCTFU2",71,0) ;S DR=".01;13;99",DIC=4,DIQ(0)="E",DIQ="VAFCTFU2" "RTN","VAFCTFU2",72,0) ;F VAFC=0:0 S VAFC=$O(LIST(VAFC)) Q:VAFC="" D "RTN","VAFCTFU2",73,0) ;.K VAFCTFU2 "RTN","VAFCTFU2",74,0) ;.S DA=+LIST(VAFC) "RTN","VAFCTFU2",75,0) ;.D EN^DIQ1 "RTN","VAFCTFU2",76,0) ;.S LIST(VAFC)=VAFCTFU2(4,+LIST(VAFC),99,"E")_"^"_VAFCTFU2(4,+LIST(VAFC),.01,"E")_"^"_$P(LIST(VAFC),"^",2)_"^"_$P(LIST(VAFC),"^",3)_"^"_VAFCTFU2(4,+LIST(VAFC),13,"E")_"^"_$P(LIST(VAFC),"^",4) "RTN","VAFCTFU2",77,0) Q "RTN","VAFCTFU2",78,0) GETICN(EDIPI) ;return the ICN when EDIPI is passed "RTN","VAFCTFU2",79,0) N EN,DFN,ICN,IEN "RTN","VAFCTFU2",80,0) S IEN=$$IEN^XUAF4("200DOD") "RTN","VAFCTFU2",81,0) I 'IEN Q "-1^Unknown Assigning Facility." "RTN","VAFCTFU2",82,0) I '$D(^DGCN(391.91,"ASCR",EDIPI,IEN)) Q "-1^EDIPI Record is unknown at this facility" "RTN","VAFCTFU2",83,0) I $D(^DGCN(391.91,"ASCR",EDIPI,IEN)) D "RTN","VAFCTFU2",84,0) .S EN=$O(^DGCN(391.91,"ASCR",EDIPI,$$IEN^XUAF4("200DOD"),"")) "RTN","VAFCTFU2",85,0) .S DFN=$P($G(^DGCN(391.91,EN,0)),"^") "RTN","VAFCTFU2",86,0) .I DFN'="" S ICN=$$GETICN^MPIF001(DFN) "RTN","VAFCTFU2",87,0) .I DFN="" S ICN="-1^No Site Record associated with this entry" "RTN","VAFCTFU2",88,0) Q ICN "RTN","VAFCTFU2",89,0) ; "RTN","VAFCTFU2",90,0) SET(TFIEN,ARY,CTR) ;This sets the array with the treating facility list. "RTN","VAFCTFU2",91,0) ; Ex ARY(1)= ^ ^ ^ ^ "RTN","VAFCTFU2",92,0) N DGCN,INSTIEN,LSTA,SOURCE,EN,NODE,SDFN,STATUS,SITEN,ID,IDTYPE,SITE,ASSAUTH,FOUND,NODE0,NODE2 "RTN","VAFCTFU2",93,0) S DGCN(0)=$G(^DGCN(391.91,TFIEN,0)),SITEN="" "RTN","VAFCTFU2",94,0) ;** FROM DG*5.3*800 - (ckn) - Quit if IPP field is not set for 200MH record "RTN","VAFCTFU2",95,0) S INSTIEN=$P($G(DGCN(0)),"^",2),LSTA=$$STA^XUAF4(INSTIEN) "RTN","VAFCTFU2",96,0) I $E(LSTA,1,5)="200MH",$P($G(DGCN(0)),"^",8)'=1 Q "RTN","VAFCTFU2",97,0) S ID=$P(DGCN(0),"^"),SITE=$P(DGCN(0),"^",2) I SITE'="" S SITEN=$$STA^XUAF4(SITE) "RTN","VAFCTFU2",98,0) ;S IDTYPE="PI" "RTN","VAFCTFU2",99,0) ;I SITEN="200DOD"!(SITEN["200N") S IDTYPE="NI" "RTN","VAFCTFU2",100,0) ;S ASSAUTH="USVHA" "RTN","VAFCTFU2",101,0) ;I SITEN="200DOD" S ASSAUTH="USDOD" "RTN","VAFCTFU2",102,0) ; GET SOURCE ID AND SOURCE STATUS - CAN BE MORE THAN ONE "RTN","VAFCTFU2",103,0) ;^DGCN(391.91,14842,0)=7169806^17942 "RTN","VAFCTFU2",104,0) ;^DGCN(391.91,14842,1,0)=^391.9101A^2^2 "RTN","VAFCTFU2",105,0) ;^DGCN(391.91,14842,1,1,0)=1^A "RTN","VAFCTFU2",106,0) ;^DGCN(391.91,14842,1,2,0)=2^H "RTN","VAFCTFU2",107,0) ;^DGCN(391.91,14842,1,"B",1,1)= "RTN","VAFCTFU2",108,0) ;^DGCN(391.91,14842,1,"B",2,2)= "RTN","VAFCTFU2",109,0) ;^DGCN(391.91,1708,0)=7169806^500^3081204.152808^^^^1 "RTN","VAFCTFU2",110,0) ;^DGCN(391.91,1708,1,0)=^391.9101A^1^1 "RTN","VAFCTFU2",111,0) ;^DGCN(391.91,1708,1,1,0)=27^H "RTN","VAFCTFU2",112,0) ;^DGCN(391.91,1708,1,"B",27,1)= "RTN","VAFCTFU2",113,0) ;**856 - MVI 1371 (ckn) "RTN","VAFCTFU2",114,0) ;After DG*5.3*837 - TREATING FACILITY LIST file #391.91 does not "RTN","VAFCTFU2",115,0) ;store Source Id value in SOURCE ID multiple field. This field is "RTN","VAFCTFU2",116,0) ;is moved to top level. We no longer need to loop through SOURNCE ID "RTN","VAFCTFU2",117,0) ;multiple to get the values. "RTN","VAFCTFU2",118,0) ;S SOURCE="",FOUND=0 "RTN","VAFCTFU2",119,0) ;I $D(^DGCN(391.91,TFIEN,1)) D "RTN","VAFCTFU2",120,0) ;.S EN=0 F S EN=$O(^DGCN(391.91,TFIEN,1,EN)) Q:EN="" D "RTN","VAFCTFU2",121,0) ;..;S NODE=$G(^DGCN(391.91,TFIEN,1,EN,0)) "RTN","VAFCTFU2",122,0) S NODE0=$G(^DGCN(391.91,TFIEN,0)) "RTN","VAFCTFU2",123,0) S NODE2=$G(^DGCN(391.91,TFIEN,2)) "RTN","VAFCTFU2",124,0) S SDFN=$P(NODE2,"^",2),STATUS=$P(NODE2,"^",3),IDTYPE=$P(NODE0,"^",9) "RTN","VAFCTFU2",125,0) S ASSAUTH=$P(NODE2,"^") "RTN","VAFCTFU2",126,0) I SITEN="200DOD"!(SITEN["200N") S IDTYPE="NI" "RTN","VAFCTFU2",127,0) I SITEN="200DOD" S ASSAUTH="USDOD" "RTN","VAFCTFU2",128,0) I IDTYPE="" S IDTYPE="PI" "RTN","VAFCTFU2",129,0) I ASSAUTH="" S ASSAUTH="USVHA" "RTN","VAFCTFU2",130,0) I SITEN["200N"&(IDTYPE="NI")&(ASSAUTH="USVHA") S ASSAUTH="" "RTN","VAFCTFU2",131,0) ;S SDFN=$P(NODE,"^"),STATUS=$P(NODE,"^",2) "RTN","VAFCTFU2",132,0) I SDFN'="" S CTR=CTR+1,@ARY@(CTR)=SDFN_"^"_IDTYPE_"^"_ASSAUTH_"^"_SITEN_"^"_STATUS,FOUND=1 "RTN","VAFCTFU2",133,0) ;I FOUND=0 S CTR=CTR+1,@ARY@(CTR)=""_"^"_IDTYPE_"^"_ASSAUTH_"^"_SITEN "RTN","VAFCTFU2",134,0) Q "RTN","VAFCTFU2",135,0) ; "RTN","VAFCTFU2",136,0) QUERYTF(PAT,ARY) ;a query for Treating Facility. "RTN","VAFCTFU2",137,0) ;INPUT PAT - The patient's ICN "RTN","VAFCTFU2",138,0) ; ARY - The array in which to return the Treating facility info. "RTN","VAFCTFU2",139,0) ;OUTPUT A list of the Treating Facilities in the array provided from "RTN","VAFCTFU2",140,0) ; the parameter. It will be in the structure of x(1), x(2) etc. "RTN","VAFCTFU2",141,0) ; Ex X(1)= ^ ^ ^ ^ "RTN","VAFCTFU2",142,0) ; "RTN","VAFCTFU2",143,0) ; This is also a function call. If there is an error then a "RTN","VAFCTFU2",144,0) ; 1^error description will be returned. "RTN","VAFCTFU2",145,0) ; "RTN","VAFCTFU2",146,0) ; *** If no data is found the array will not be populated and "RTN","VAFCTFU2",147,0) ; a 1^error description will be returned. "RTN","VAFCTFU2",148,0) ; "RTN","VAFCTFU2",149,0) N PDFN,VAFCER,LP,CTR "RTN","VAFCTFU2",150,0) ; "RTN","VAFCTFU2",151,0) ; ICN is not required, comment out "RTN","VAFCTFU2",152,0) ; I '$G(PAT)!('$D(ARY)) S VAFCER="1^Parameter missing." G QUERYTFQ "RTN","VAFCTFU2",153,0) I ('$D(ARY)) S VAFCER="1^Parameter missing." G QUERYTFQ "RTN","VAFCTFU2",154,0) S VAFCER=0,CTR=1 "RTN","VAFCTFU2",155,0) S X="MPIF001" X ^%ZOSF("TEST") I '$T G QUERYTFQ "RTN","VAFCTFU2",156,0) ; ICN is not required, comment out "RTN","VAFCTFU2",157,0) ; S PDFN=$$GETDFN^MPIF001(PAT) "RTN","VAFCTFU2",158,0) ; I PDFN<0 S VAFCER="1^No patient DFN." G QUERYTFQ "RTN","VAFCTFU2",159,0) S PDFN=$G(DFN) "RTN","VAFCTFU2",160,0) I '$G(PDFN) S VAFCER="1^DFN is not defined." G QUERYTFQ "RTN","VAFCTFU2",161,0) ;SET FIRST ENTRY TO BE THE ICN - FULL ICN - PAT IS NOT THE ICN "RTN","VAFCTFU2",162,0) S @ARY@(CTR)=$$GETICN^MPIF001(PDFN)_"^NI^USVHA^200M^A" "RTN","VAFCTFU2",163,0) ;**856 - MVI 1371 (ckn) "RTN","VAFCTFU2",164,0) ;Loop through all TFIENs for site "RTN","VAFCTFU2",165,0) ;F LP=0:0 S LP=$O(^DGCN(391.91,"APAT",PDFN,LP)) Q:'LP S TFIEN=$O(^(LP,"")) D SET(TFIEN,ARY,.CTR) "RTN","VAFCTFU2",166,0) F LP=0:0 S LP=$O(^DGCN(391.91,"APAT",PDFN,LP)) Q:'LP D "RTN","VAFCTFU2",167,0) .S TFIEN=0 F S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,LP,TFIEN)) Q:'TFIEN D "RTN","VAFCTFU2",168,0) ..D SET(TFIEN,ARY,.CTR) "RTN","VAFCTFU2",169,0) I $D(@ARY)'>9 S VAFCER="1^Could not find Treating Facilities" "RTN","VAFCTFU2",170,0) QUERYTFQ Q VAFCER "RTN","VAFCTFU2",171,0) ; "RTN","VAFCTFU2",172,0) NEWTF(RESULT,DFN,EDIPI) ; "RTN","VAFCTFU2",173,0) ; for MPIC_2019 "RTN","VAFCTFU2",174,0) ; called from RPC: VAFC NEW NC TREATING FACILITY "RTN","VAFCTFU2",175,0) ; Input: "RTN","VAFCTFU2",176,0) ; DFN: Vista Patient Identifier will be the PATIENT file (#2) IEN (aka DFN) "RTN","VAFCTFU2",177,0) ; example of DFN="7168937" "RTN","VAFCTFU2",178,0) ; "RTN","VAFCTFU2",179,0) ; EDIPI: The DOD Identifier will be EDIPI data with the "RTN","VAFCTFU2",180,0) ; following format: "RTN","VAFCTFU2",181,0) ; Id^IdType^AssigningAuthority^AssigningFacility "RTN","VAFCTFU2",182,0) ; example: 852043888^NI^USDOD^200DOD "RTN","VAFCTFU2",183,0) ; "RTN","VAFCTFU2",184,0) ; Return: "RTN","VAFCTFU2",185,0) ; This will return a list of treating facilities in the following. "RTN","VAFCTFU2",186,0) ; "RTN","VAFCTFU2",187,0) ; format: "RTN","VAFCTFU2",188,0) ; Id^IdType^AssigningAuthority^AssigningFacility^IdStatus[^NEW] "RTN","VAFCTFU2",189,0) ; "RTN","VAFCTFU2",190,0) ; Examples: "RTN","VAFCTFU2",191,0) ; RESULT(1)="7168937^PI^USVHA^500^A" "RTN","VAFCTFU2",192,0) ; RESULT(2)="85204388^NI^USDOD^200DOD^A^NEW" "RTN","VAFCTFU2",193,0) ; Note: If there is data in the 6th piece of the RESULT(), "RTN","VAFCTFU2",194,0) ; with data value as "NEW", then it means that the entry was "RTN","VAFCTFU2",195,0) ; newly created in the TREATING FACILITY LIST (#391.91) file "RTN","VAFCTFU2",196,0) ; by this RPC call. "RTN","VAFCTFU2",197,0) ; "RTN","VAFCTFU2",198,0) N X,TYPE,SITE,ID,ASSIGN,PTDFN,LP,CTR,NCTFIEN,ERROR,II "RTN","VAFCTFU2",199,0) S X="MPIF001" X ^%ZOSF("TEST") I '$T S RESULT(1)="-1^MPI Not Installed" Q "RTN","VAFCTFU2",200,0) ; clear "return" variable "RTN","VAFCTFU2",201,0) K RESULT "RTN","VAFCTFU2",202,0) ; input parameters "RTN","VAFCTFU2",203,0) S PTDFN=$G(DFN) "RTN","VAFCTFU2",204,0) I 'PTDFN S RESULT(1)="-1^Invalid DFN:"""_PTDFN_"""" Q "RTN","VAFCTFU2",205,0) ; check the field #.01 data in patient entry "RTN","VAFCTFU2",206,0) I $P($G(^DPT(PTDFN,0)),"^")']"" D Q "RTN","VAFCTFU2",207,0) . S RESULT(1)="-1^No patient in database for the DFN:"_PTDFN "RTN","VAFCTFU2",208,0) ; "RTN","VAFCTFU2",209,0) S ID=$P(EDIPI,"^"),TYPE=$P(EDIPI,"^",2),ASSIGN=$P(EDIPI,"^",3) "RTN","VAFCTFU2",210,0) S SITE=$P(EDIPI,"^",4) "RTN","VAFCTFU2",211,0) ; "RTN","VAFCTFU2",212,0) I ID']"" S RESULT(1)="-1^Id is not defined." Q "RTN","VAFCTFU2",213,0) I TYPE'="NI" S RESULT(1)="-1^Invalid Id Type." Q "RTN","VAFCTFU2",214,0) I ASSIGN'="USDOD" S RESULT(1)="-1^Invalid Assigning Authority." Q "RTN","VAFCTFU2",215,0) I SITE'="200DOD" S RESULT(1)="-1^Invalid Assigning Facility." Q "RTN","VAFCTFU2",216,0) S SITEIEN=$O(^DIC(4,"D","200DOD",0)) "RTN","VAFCTFU2",217,0) I 'SITEIEN S RESULT(1)="-1^Assigning Facility is not defined in database." Q "RTN","VAFCTFU2",218,0) ; "RTN","VAFCTFU2",219,0) ; get ien of file #391.91 "RTN","VAFCTFU2",220,0) S NCTFIEN=$O(^DGCN(391.91,"APAT",PTDFN,SITEIEN,0)) "RTN","VAFCTFU2",221,0) ; "RTN","VAFCTFU2",222,0) ; Assigning Facility as "200DOD" of the patient is already existed "RTN","VAFCTFU2",223,0) ; in file #391.91 "RTN","VAFCTFU2",224,0) S CTR=0 "RTN","VAFCTFU2",225,0) I NCTFIEN D Q "RTN","VAFCTFU2",226,0) . N TFIEN "RTN","VAFCTFU2",227,0) . F LP=0:0 S LP=$O(^DGCN(391.91,"APAT",PTDFN,LP)) Q:'LP S TFIEN=$O(^(LP,0)) D "RTN","VAFCTFU2",228,0) .. Q:'TFIEN "RTN","VAFCTFU2",229,0) .. ; retrieve entry in file #391.91 "RTN","VAFCTFU2",230,0) .. D SET(TFIEN,"RESULT",.CTR) "RTN","VAFCTFU2",231,0) ; "RTN","VAFCTFU2",232,0) ; add new entry to file #391.91 "RTN","VAFCTFU2",233,0) D FILENEW^VAFCTFU(PTDFN,SITEIEN,"","","",.ERROR,"",ID,"A") "RTN","VAFCTFU2",234,0) I $D(ERROR(SITEIEN)) D Q "RTN","VAFCTFU2",235,0) . S RESULT(1)="-1^"_$G(ERROR(SITEIEN)) "RTN","VAFCTFU2",236,0) ; "RTN","VAFCTFU2",237,0) ; for Cache client/server model in case that there is a delay for "RTN","VAFCTFU2",238,0) ; retrieving the new created entry. "RTN","VAFCTFU2",239,0) F II=1:1:5 Q:$O(^DGCN(391.91,"APAT",PTDFN,SITEIEN,0)) H II "RTN","VAFCTFU2",240,0) ; retrieving the results "RTN","VAFCTFU2",241,0) F LP=0:0 S LP=$O(^DGCN(391.91,"APAT",PTDFN,LP)) Q:'LP S TFIEN=$O(^(LP,0)) D "RTN","VAFCTFU2",242,0) . Q:'TFIEN "RTN","VAFCTFU2",243,0) . ; retrieve entry in file #391.91 "RTN","VAFCTFU2",244,0) . D SET(TFIEN,"RESULT",.CTR) "RTN","VAFCTFU2",245,0) . I $P($G(RESULT(CTR)),"^",3)="USDOD" S RESULT(CTR)=RESULT(CTR)_"^NEW" "RTN","VAFCTFU2",246,0) Q "RTN","VAFCTFU2",247,0) ; "VER") 8.0^22.0 "^DD",391.91,391.91,.02,0) INSTITUTION^RP4'Ia^DIC(4,^0;2^Q "^DD",391.91,391.91,.02,1,0) ^.1 "^DD",391.91,391.91,.02,1,1,0) 391.91^C "^DD",391.91,391.91,.02,1,1,1) S ^DGCN(391.91,"C",$E(X,1,30),DA)="" "^DD",391.91,391.91,.02,1,1,2) K ^DGCN(391.91,"C",$E(X,1,30),DA) "^DD",391.91,391.91,.02,1,1,"%D",0) ^^1^1^2990111^^^^ "^DD",391.91,391.91,.02,1,1,"%D",1,0) This is a lookup cross-reference on the institution. "^DD",391.91,391.91,.02,1,1,"DT") 2960909 "^DD",391.91,391.91,.02,1,2,0) 391.91^APAT2^MUMPS "^DD",391.91,391.91,.02,1,2,1) N TMPA S TMPA=$P($G(^DGCN(391.91,DA,0)),U,1) I TMPA S ^DGCN(391.91,"APAT",TMPA,$E(X,1,30),DA)="" "^DD",391.91,391.91,.02,1,2,2) N TMPA S TMPA=$P($G(^DGCN(391.91,DA,0)),U,1) I TMPA K ^DGCN(391.91,"APAT",TMPA,$E(X,1,30),DA) "^DD",391.91,391.91,.02,1,2,"%D",0) ^^2^2^2990111^^^^ "^DD",391.91,391.91,.02,1,2,"%D",1,0) This cross-reference is used to uniquely identify the institutions "^DD",391.91,391.91,.02,1,2,"%D",2,0) at which a patient has been seen. "^DD",391.91,391.91,.02,1,2,"DT") 2960909 "^DD",391.91,391.91,.02,1,3,0) 391.91^AINST2^MUMPS "^DD",391.91,391.91,.02,1,3,1) N TMPA S TMPA=$P($G(^DGCN(391.91,DA,0)),U,1) I TMPA S ^DGCN(391.91,"AINST",$E(X,1,30),TMPA,DA)="" "^DD",391.91,391.91,.02,1,3,2) N TMPA S TMPA=$P($G(^DGCN(391.91,DA,0)),U,1) I TMPA K ^DGCN(391.91,"AINST",$E(X,1,30),TMPA,DA) "^DD",391.91,391.91,.02,1,3,"%D",0) ^^2^2^2990111^^^^ "^DD",391.91,391.91,.02,1,3,"%D",1,0) This cross-reference is used to uniquely identify the patients for "^DD",391.91,391.91,.02,1,3,"%D",2,0) a particular institution. "^DD",391.91,391.91,.02,1,3,"DT") 2960909 "^DD",391.91,391.91,.02,3) Enter the institution where the patient was seen, between 1 and 30 characters. "^DD",391.91,391.91,.02,9) @ "^DD",391.91,391.91,.02,21,0) ^^1^1^2990111^^^^ "^DD",391.91,391.91,.02,21,1,0) This is the institution where the patient was treated. "^DD",391.91,391.91,.02,"AUDIT") y "^DD",391.91,391.91,.02,"DT") 3120521 "^DD",391.91,391.91,.09,0) SOURCE ID TYPE^Sa^NI:National unique individual identifier;PI:Patient internal identifier;PN:Person number;EI:Employee number;SS:Social Security number;NPI:National provider identifier;^0;9^Q "^DD",391.91,391.91,.09,.1) Source ID Type "^DD",391.91,391.91,.09,3) Enter the SOURCE ID TYPE value for this entry. "^DD",391.91,391.91,.09,21,0) ^^6^6^3100721^ "^DD",391.91,391.91,.09,21,1,0) The SOURCE ID TYPE field defines the data source for this entry. "^DD",391.91,391.91,.09,21,2,0) The source ID type is a reference to the HL7 Table 0203, Identifier Type, "^DD",391.91,391.91,.09,21,3,0) and the VA Identity Management user defined values: NI (National "^DD",391.91,391.91,.09,21,4,0) Identifier), PI (Patient Identifier), PN (Person Number), EI (Employee "^DD",391.91,391.91,.09,21,5,0) Identifier), SS (Social Security Number), and NPI (National Provider "^DD",391.91,391.91,.09,21,6,0) Identifier). "^DD",391.91,391.91,.09,"AUDIT") y "^DD",391.91,391.91,.09,"DT") 3120521 "^DD",391.91,391.91,10,0) ASSIGNING AUTHORITY^Fa^^2;1^K:$L(X)>70!($L(X)<1) X "^DD",391.91,391.91,10,.1) Assigning Authority "^DD",391.91,391.91,10,3) ASSIGNING AUTHORITY must be 1-70 characters in length. "^DD",391.91,391.91,10,21,0) ^.001^9^9^3111031^^ "^DD",391.91,391.91,10,21,1,0) ASSIGNING AUTHORITY stores a portion of the data used to assemble fully "^DD",391.91,391.91,10,21,2,0) qualified identifiers used for either the HL7 v2.4 or v3.0 standard. It "^DD",391.91,391.91,10,21,3,0) is based on the Health Level Seven (HL7) standardized table 0363 and "^DD",391.91,391.91,10,21,4,0) contains the universal ID subcomponent of the assigning authority "^DD",391.91,391.91,10,21,5,0) component in the standard PID-3 identifier. "^DD",391.91,391.91,10,21,6,0) "^DD",391.91,391.91,10,21,7,0) The fully qualified HL7 identifier is composed of the PATIENT (#.01), "^DD",391.91,391.91,10,21,8,0) INSTITUTION (#.02), SOURCE ID (#11), ASSIGNING AUTHORITY (#10), and "^DD",391.91,391.91,10,21,9,0) SOURCE ID TYPE (#.09), which constitute a unique entry. "^DD",391.91,391.91,10,"AUDIT") y "^DD",391.91,391.91,10,"DT") 3120510 "^DD",391.91,391.91,11,0) SOURCE ID^Fa^^2;2^K:$L(X)>150!($L(X)<1) X "^DD",391.91,391.91,11,.1) SourceID "^DD",391.91,391.91,11,3) Answer must be 1-150 characters in length. "^DD",391.91,391.91,11,21,0) ^.001^9^9^3111031^^ "^DD",391.91,391.91,11,21,1,0) SOURCE ID is the unique system assigned identifier at the identified "^DD",391.91,391.91,11,21,2,0) facility for the patient record. The value of SOURCE ID varies, "^DD",391.91,391.91,11,21,3,0) depending on the source facility. "^DD",391.91,391.91,11,21,4,0) "^DD",391.91,391.91,11,21,5,0) If SOURCE ID is from the Master Patient Index, the value is the "^DD",391.91,391.91,11,21,6,0) Integration Control Number (ICN). If SOURCE ID is from the Department of "^DD",391.91,391.91,11,21,7,0) Defense (DoD), the value is the Electronic Data Interchange Personal "^DD",391.91,391.91,11,21,8,0) Identifier (EDIPI), which is their equivalent of an ICN. In the future, "^DD",391.91,391.91,11,21,9,0) SOURCE ID may come from other sources due to additional initiatives. "^DD",391.91,391.91,11,"AUDIT") y "^DD",391.91,391.91,11,"DT") 3120510 "BLD",2917,6) ^754 **END** **END**