Released DG*5.3*857 SEQ #765 Extracted from mail message **KIDS**:DG*5.3*857^ **INSTALL NAME** DG*5.3*857 "BLD",2918,0) DG*5.3*857^REGISTRATION^0^3130725^y "BLD",2918,1,0) ^^3^3^3120918^ "BLD",2918,1,1,0) VIC 4.02 MPI INTEGRATION "BLD",2918,1,2,0) Refer to patch DG*5.3*857 in the FORUM Patch Module for a complete "BLD",2918,1,3,0) description. "BLD",2918,4,0) ^9.64PA^^ "BLD",2918,6.3) 8 "BLD",2918,"ABPKG") n "BLD",2918,"KRN",0) ^9.67PA^779.2^20 "BLD",2918,"KRN",.4,0) .4 "BLD",2918,"KRN",.401,0) .401 "BLD",2918,"KRN",.402,0) .402 "BLD",2918,"KRN",.403,0) .403 "BLD",2918,"KRN",.5,0) .5 "BLD",2918,"KRN",.84,0) .84 "BLD",2918,"KRN",3.6,0) 3.6 "BLD",2918,"KRN",3.8,0) 3.8 "BLD",2918,"KRN",9.2,0) 9.2 "BLD",2918,"KRN",9.8,0) 9.8 "BLD",2918,"KRN",9.8,"NM",0) ^9.68A^3^3 "BLD",2918,"KRN",9.8,"NM",1,0) DPTLK^^0^B114088511 "BLD",2918,"KRN",9.8,"NM",2,0) DPTLK4^^0^B3734144 "BLD",2918,"KRN",9.8,"NM",3,0) DGROUT^^0^B18071448 "BLD",2918,"KRN",9.8,"NM","B","DGROUT",3) "BLD",2918,"KRN",9.8,"NM","B","DPTLK",1) "BLD",2918,"KRN",9.8,"NM","B","DPTLK4",2) "BLD",2918,"KRN",19,0) 19 "BLD",2918,"KRN",19.1,0) 19.1 "BLD",2918,"KRN",101,0) 101 "BLD",2918,"KRN",409.61,0) 409.61 "BLD",2918,"KRN",771,0) 771 "BLD",2918,"KRN",779.2,0) 779.2 "BLD",2918,"KRN",870,0) 870 "BLD",2918,"KRN",8989.51,0) 8989.51 "BLD",2918,"KRN",8989.52,0) 8989.52 "BLD",2918,"KRN",8994,0) 8994 "BLD",2918,"KRN",8994,"NM",0) ^9.68A^1^1 "BLD",2918,"KRN",8994,"NM",1,0) DG VIC PATIENT LOOKUP^^0 "BLD",2918,"KRN",8994,"NM","B","DG VIC PATIENT LOOKUP",1) "BLD",2918,"KRN","B",.4,.4) "BLD",2918,"KRN","B",.401,.401) "BLD",2918,"KRN","B",.402,.402) "BLD",2918,"KRN","B",.403,.403) "BLD",2918,"KRN","B",.5,.5) "BLD",2918,"KRN","B",.84,.84) "BLD",2918,"KRN","B",3.6,3.6) "BLD",2918,"KRN","B",3.8,3.8) "BLD",2918,"KRN","B",9.2,9.2) "BLD",2918,"KRN","B",9.8,9.8) "BLD",2918,"KRN","B",19,19) "BLD",2918,"KRN","B",19.1,19.1) "BLD",2918,"KRN","B",101,101) "BLD",2918,"KRN","B",409.61,409.61) "BLD",2918,"KRN","B",771,771) "BLD",2918,"KRN","B",779.2,779.2) "BLD",2918,"KRN","B",870,870) "BLD",2918,"KRN","B",8989.51,8989.51) "BLD",2918,"KRN","B",8989.52,8989.52) "BLD",2918,"KRN","B",8994,8994) "BLD",2918,"QDEF") ^^^^^^^^^^YES "BLD",2918,"QUES",0) ^9.62^^ "BLD",2918,"REQB",0) ^9.611^2^2 "BLD",2918,"REQB",1,0) DG*5.3*769^2 "BLD",2918,"REQB",2,0) DG*5.3*572^2 "BLD",2918,"REQB","B","DG*5.3*572",2) "BLD",2918,"REQB","B","DG*5.3*769",1) "KRN",8994,285,-1) 0^1 "KRN",8994,285,0) DG VIC PATIENT LOOKUP^RPCVIC^DPTLK^1^P "KRN",8994,285,1,0) ^^4^4^3121024^ "KRN",8994,285,1,1,0) This RPC will allow lookup of a patient with the input from a VIC card or "KRN",8994,285,1,2,0) DOD CAC card. The VIC card can be an old VIC card or the newer VIC 4.0 "KRN",8994,285,1,3,0) card. The entire card's input should be provided. If the patient is "KRN",8994,285,1,4,0) known locally the patient's DFN will be returned. "KRN",8994,285,2,0) ^8994.02A^1^1 "KRN",8994,285,2,1,0) DPTX^1^255^1^1 "KRN",8994,285,2,1,1,0) ^8994.021^2^2^3121024^^ "KRN",8994,285,2,1,1,1,0) This should be the entire input from either the Magnetic Strip or the "KRN",8994,285,2,1,1,2,0) Barcode. "KRN",8994,285,2,"B","DPTX",1) "KRN",8994,285,2,"PARAMSEQ",1,1) "KRN",8994,285,3,0) ^8994.03^2^2^3121024^^ "KRN",8994,285,3,1,0) If the patient is known locally the patient's DFN is returned. If not "KRN",8994,285,3,2,0) then a -1 is returned. "MBREQ") 0 "ORD",16,8994) 8994;16;1;;;;;;;RPCDEL^XPDIA1 "ORD",16,8994,0) REMOTE PROCEDURE "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) 857^3130725^12664 "PKG",5,22,1,"PAH",1,1,0) ^^3^3^3130725 "PKG",5,22,1,"PAH",1,1,1,0) VIC 4.02 MPI INTEGRATION "PKG",5,22,1,"PAH",1,1,2,0) Refer to patch DG*5.3*857 in the FORUM Patch Module for a complete "PKG",5,22,1,"PAH",1,1,3,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") 3 "RTN","DGROUT") 0^3^B18071448^B15077176 "RTN","DGROUT",1,0) DGROUT ;DJH/AMA - ROM UTILITIES ; 28 Apr 2004 12:24 PM "RTN","DGROUT",2,0) ;;5.3;Registration;**533,572,857**;Aug 13, 1993;Build 8 "RTN","DGROUT",3,0) ; "RTN","DGROUT",4,0) Q ;no direct entry "RTN","DGROUT",5,0) ; "RTN","DGROUT",6,0) MPIOK(DGDFN,DGICN,DGLST) ;return non-local LST and ICN "RTN","DGROUT",7,0) ;This function retrieves an ICN given a pointer to the PATIENT (#2) "RTN","DGROUT",8,0) ;file for a patient. When the ICN is not local and the local site "RTN","DGROUT",9,0) ;is not the Last Site Treated (LST), the LST is retrieved as a "RTN","DGROUT",10,0) ;pointer to the INSTITUTION (#4) file. "RTN","DGROUT",11,0) ; Called from SNDQRY^DGROHLR "RTN","DGROUT",12,0) ; "RTN","DGROUT",13,0) ; Supported DBIA #2701: The supported DBIA is used to access MPI "RTN","DGROUT",14,0) ; APIs to retrieve ICN, determine if ICN "RTN","DGROUT",15,0) ; is local and if site is LST. "RTN","DGROUT",16,0) ; Supported DBIA #2702: The supported DBIA is used to retrieve the "RTN","DGROUT",17,0) ; MPI node from the PATIENT (#2) file. "RTN","DGROUT",18,0) ; "RTN","DGROUT",19,0) ; Input: "RTN","DGROUT",20,0) ; DGDFN - IEN of patient in PATIENT (#2) file "RTN","DGROUT",21,0) ; DGICN - passed by reference to contain national ICN "RTN","DGROUT",22,0) ; DGLST - passed by reference to contain LST "RTN","DGROUT",23,0) ; "RTN","DGROUT",24,0) ; Output: "RTN","DGROUT",25,0) ; Function Value - 1 on national ICN and non-local LST, 0 on failure "RTN","DGROUT",26,0) ; DGICN - Patient's Integrated Control Number "RTN","DGROUT",27,0) ; DGLST - Pointer to INSTITUTION (#4) file for LST if LST "RTN","DGROUT",28,0) ; is not local, undefined otherwise. "RTN","DGROUT",29,0) ; "RTN","DGROUT",30,0) N DGRSLT "RTN","DGROUT",31,0) S DGRSLT=0 "RTN","DGROUT",32,0) I $G(DGDFN)>0,$D(^DPT(DGDFN,"MPI")) D "RTN","DGROUT",33,0) . S DGICN=$$GETICN^MPIF001(DGDFN) "RTN","DGROUT",34,0) . ; "RTN","DGROUT",35,0) . ;ICN must be valid "RTN","DGROUT",36,0) . I (DGICN'>0) D Q "RTN","DGROUT",37,0) . . S DGMSG(1)=" " "RTN","DGROUT",38,0) . . S DGMSG(2)="The query to the LST has been terminated because required" "RTN","DGROUT",39,0) . . S DGMSG(3)="information was not provided by the MPI." "RTN","DGROUT",40,0) . . D EN^DDIOL(.DGMSG) R A:5 "RTN","DGROUT",41,0) . ; "RTN","DGROUT",42,0) . ;ICN must not be local "RTN","DGROUT",43,0) . I $$IFLOCAL^MPIF001(DGDFN) D Q "RTN","DGROUT",44,0) . . S DGMSG(1)=" " "RTN","DGROUT",45,0) . . S DGMSG(2)="The query to the LST has been terminated because required" "RTN","DGROUT",46,0) . . S DGMSG(3)="information was not provided by the MPI." "RTN","DGROUT",47,0) . . D EN^DDIOL(.DGMSG) R A:5 "RTN","DGROUT",48,0) . ; "RTN","DGROUT",49,0) . ;Get LST from Treating Facility List "RTN","DGROUT",50,0) . S DGLST=$$TFL(DGDFN) "RTN","DGROUT",51,0) . ; "RTN","DGROUT",52,0) . ; - Adding delay for TFL to complete if MPI card scan/swipe "RTN","DGROUT",53,0) . I $G(DGNEW),DGLST'>0 D "RTN","DGROUT",54,0) . . N DGHANG "RTN","DGROUT",55,0) . . W !,"Attempting to connect to the Master Patient Index in Austin..." "RTN","DGROUT",56,0) . . W !,"Looking for other treating facilities may take some time," "RTN","DGROUT",57,0) . . W !,"please be patient..." "RTN","DGROUT",58,0) . . F DGHANG=1:1:30 H 1 S DGLST=$$TFL(DGDFN) Q:DGLST>0 "RTN","DGROUT",59,0) . ; "RTN","DGROUT",60,0) . I (DGLST'>0) D Q "RTN","DGROUT",61,0) . . S DGMSG(1)=" " "RTN","DGROUT",62,0) . . S DGMSG(2)="The query to the LST has been terminated because required" "RTN","DGROUT",63,0) . . S DGMSG(3)="information was not provided by the MPI." "RTN","DGROUT",64,0) . . D EN^DDIOL(.DGMSG) R A:5 "RTN","DGROUT",65,0) . ; "RTN","DGROUT",66,0) . S DGRSLT=1 "RTN","DGROUT",67,0) Q DGRSLT "RTN","DGROUT",68,0) ; "RTN","DGROUT",69,0) TFL(DFN) ; "RTN","DGROUT",70,0) ;Retrieve Last Site Treated from the Treating Facility List ^DGCN(391.91 "RTN","DGROUT",71,0) ;This function will retrieve the most recent treatment site "RTN","DGROUT",72,0) ;from the Treating Facility List (TFL) received from the MPI "RTN","DGROUT",73,0) ; "RTN","DGROUT",74,0) ; Input: "RTN","DGROUT",75,0) ; DFN - (required) IEN of patient in PATIENT (#2) File "RTN","DGROUT",76,0) ; "RTN","DGROUT",77,0) ; Output: "RTN","DGROUT",78,0) ; Function value - Facility IEN on success, 0 on failure "RTN","DGROUT",79,0) ; "RTN","DGROUT",80,0) N RSLT ;Result returned from call "RTN","DGROUT",81,0) N QFL ;Quit flag "RTN","DGROUT",82,0) N TFLDR ;Treating Facility List Record Number "RTN","DGROUT",83,0) N DATA ;Array of TFL data "RTN","DGROUT",84,0) N RDATA ;Array of Treating Facilities arranged by date and TFLDR "RTN","DGROUT",85,0) N DATE,TFL "RTN","DGROUT",86,0) ; "RTN","DGROUT",87,0) S (RSLT,QFL)=0 "RTN","DGROUT",88,0) ;Check to see if there is a TFL for this patient. "RTN","DGROUT",89,0) ;If not exit and return -1 to call. "RTN","DGROUT",90,0) I '$D(^DGCN(391.91,"B",DFN)) G EXITTFL "RTN","DGROUT",91,0) ; "RTN","DGROUT",92,0) ;Go through the "B" index of TFL file and retrieve "RTN","DGROUT",93,0) ;record numbers for the patient DFN. "RTN","DGROUT",94,0) S TFLDR="" F S TFLDR=$O(^DGCN(391.91,"B",DFN,TFLDR)) Q:TFLDR="" D "RTN","DGROUT",95,0) . ;Retrieve data from record and store in DATA array by record number. "RTN","DGROUT",96,0) . S DATA(TFLDR)=$G(^DGCN(391.91,TFLDR,0)) "RTN","DGROUT",97,0) . ;Extract DATE from 3rd piece of record "RTN","DGROUT",98,0) . S DATE=$P(DATA(TFLDR),"^",3) "RTN","DGROUT",99,0) . ;Quit if DATE is null "RTN","DGROUT",100,0) . Q:DATE="" "RTN","DGROUT",101,0) . ;Get Station Number using the facility pointer to the Institution (#4) file "RTN","DGROUT",102,0) . S FAC=$P(DATA(TFLDR),"^",2) "RTN","DGROUT",103,0) . S FAC=$$STA^XUAF4(FAC) Q:FAC="" "RTN","DGROUT",104,0) . ;Build RDATA array using the DATE and TFLDR "RTN","DGROUT",105,0) . S RDATA(DATE,TFLDR)=FAC "RTN","DGROUT",106,0) ;Exit if the RDATA array does not exist. "RTN","DGROUT",107,0) G:'$D(RDATA) EXITTFL "RTN","DGROUT",108,0) ; "RTN","DGROUT",109,0) ;Reverse order through the RDATA array (start with the latest date). "RTN","DGROUT",110,0) ;Extract the treating facility from the RDATA array. "RTN","DGROUT",111,0) ;Check the facility against local facility number: if they are "RTN","DGROUT",112,0) ;the same, then get the next facility. (Should never happen) "RTN","DGROUT",113,0) S DATE="" F S DATE=$O(RDATA(DATE),-1) Q:DATE="" D Q:QFL=1 "RTN","DGROUT",114,0) . S TFL="" F S TFL=$O(RDATA(DATE,TFL)) Q:TFL="" D Q:QFL=1 "RTN","DGROUT",115,0) . . S FAC=RDATA(DATE,TFL) I FAC=$G(DIV(0)) Q "RTN","DGROUT",116,0) . . ;If the facility is not the current facility, then set RSLT to the facility and quit "RTN","DGROUT",117,0) . . S RSLT=FAC,QFL=1 ;set QFL to 1 to stop going through the RDATA array "RTN","DGROUT",118,0) EXITTFL Q RSLT ;Return the LST to the calling routine "RTN","DPTLK") 0^1^B114088511^B66931183 "RTN","DPTLK",1,0) DPTLK ;ALB/RMO,RTK - MAS Patient Look-up Main Routine ; 3/22/05 4:19pm "RTN","DPTLK",2,0) ;;5.3;Registration;**32,72,93,73,136,157,197,232,265,277,223,327,244,513,528,541,576,600,485,633,629,647,769,857**;Aug 13, 1993;Build 8 "RTN","DPTLK",3,0) ; "RTN","DPTLK",4,0) ; mods made for magstripe read 12/96 - JFP "RTN","DPTLK",5,0) ; mods made for VIC 4.0 (barcode and magstripe) read 4/2012 - ELZ (*857) "RTN","DPTLK",6,0) ; "RTN","DPTLK",7,0) ;Optional input: DPTNOFZY='1' to suppress fuzzy lookups implemented "RTN","DPTLK",8,0) ; by patch DG*5.3*244 "RTN","DPTLK",9,0) ; "RTN","DPTLK",10,0) EN ; -- Entry point "RTN","DPTLK",11,0) N DIE,DR "RTN","DPTLK",12,0) K DPTX,DPTDFN,DPTSAVX I $D(DIC(0)) G QK:DIC(0)["I"!(DIC(0)'["A"&('$D(X))) "RTN","DPTLK",13,0) I '$D(^DD("VERSION")) W !!?3,"Unable to proceed. Fileman version node ^DD(""VERSION"") is undefined." G QK "RTN","DPTLK",14,0) I '$D(^DPT(0))!(^DD("VERSION")<17.2) W !!?3,"Unable to proceed. ",$S('$D(^DPT(0)):"0th node of ^DPT missing",^DD("VERSION")<17.2:"Fileman version must be at least 17.2",1:""),"." G QK "RTN","DPTLK",15,0) EN2 K DO,DUOUT,DTOUT S U="^",DIC="^DPT(",DIC(0)=$S($D(DIC(0)):DIC(0),1:"AELMQ") S:DIC(0)'["A" (DPTX,DPTSAVX)=X "RTN","DPTLK",16,0) S DPTSZ=1000 I $D(^DD("OS"))#2 S DPTSZ=$S(+$P(^DD("OS",^("OS"),0),U,2):$P(^(0),U,2),1:DPTSZ) "RTN","DPTLK",17,0) ; "RTN","DPTLK",18,0) ASKPAT ; -- Prompt for patient "RTN","DPTLK",19,0) I DIC(0)["A" D G QK:'$T!($E(DPTX)["^")!(DPTX="") "RTN","DPTLK",20,0) .K DTOUT,DUOUT,DGNEW "RTN","DPTLK",21,0) .W !,$S($D(DIC("A")):DIC("A"),1:"Select PATIENT NAME: ") W:$D(DIC("B")) DIC("B"),"// " "RTN","DPTLK",22,0) .R X:DTIME "RTN","DPTLK",23,0) .S DPTX=X S:'$T DTOUT=1 S:$T&(DPTX="")&($D(DIC("B"))) DPTX=DIC("B") S:DPTX["^"&($E(DPTX)'="%") DUOUT=1 "RTN","DPTLK",24,0) ; -- Check for the IATA magnetic stripe input "RTN","DPTLK",25,0) N MAG,GCHK,BARCODE,DGVIC40,DGCAC "RTN","DPTLK",26,0) S (MAG,BARCODE,DGVIC40,DGCAC)=0 "RTN","DPTLK",27,0) I $E(DPTX)="%"!($E(DPTX)=";"),DPTX["?" S MAG=1,(X,DPTX)=$$IATA(DPTX) "RTN","DPTLK",28,0) I 'MAG,DPTX?1"%"1N13UNP.3UN S BARCODE=1,(X,DPTX)=$$BARCODE(DPTX) "RTN","DPTLK",29,0) ; - read other line but don't use dbia#10096 don't display input "RTN","DPTLK",30,0) I $G(DGVIC40),'BARCODE X ^%ZOSF("EOFF") R X(1):1 X ^%ZOSF("EON") "RTN","DPTLK",31,0) I 'MAG,'BARCODE,DPTX?1N6UN1U7UN1U2UN S DGCAC=1,(X,DPTX)=$$CACCARD(DPTX) "RTN","DPTLK",32,0) ; "RTN","DPTLK",33,0) CHKPAT ; -- Custom Patient Lookup "RTN","DPTLK",34,0) D DO^DIC1 "RTN","DPTLK",35,0) S DIC("W")=$S($D(DIC("W")):DIC("W"),1:"") "RTN","DPTLK",36,0) K DPTIFNS,DPTS,DPTSEL "RTN","DPTLK",37,0) S DPTCNT=0 "RTN","DPTLK",38,0) ; -- Check input for format an length "RTN","DPTLK",39,0) G CHKDFN:DPTX?1A!(DPTX'?.ANP)!($L(DPTX)>30)&('$G(DGVIC40)) "RTN","DPTLK",40,0) ; -- Check for null response or abort "RTN","DPTLK",41,0) I DPTX=""!(DPTX["^") G ASKPAT:DIC(0)["A",QK "RTN","DPTLK",42,0) ; -- Check for question mark "RTN","DPTLK",43,0) I DPTX["?" D G ASKPAT:DIC(0)["A",QK "RTN","DPTLK",44,0) .S D="B" "RTN","DPTLK",45,0) .S DZ=$S(DPTX?1"?":"",1:"??") "RTN","DPTLK",46,0) .G CHKPAT1:DZ="??" "RTN","DPTLK",47,0) .N % "RTN","DPTLK",48,0) .W !,?1,"Answer with PATIENT NAME, or SOCIAL SECURITY NUMBER, or last 4 digits",!,?4,"of SOCIAL SECURITY NUMBER, or first initial of" "RTN","DPTLK",49,0) .W " last name with last",!,?4,"4 digits of SOCIAL SECURITY NUMBER" "RTN","DPTLK",50,0) .W !,?1,"Do you want the entire ",+$P($G(^DPT(0)),"^",4),"-Entry PATIENT List" S %=0 D YN^DICN "RTN","DPTLK",51,0) .Q:%'=1 "RTN","DPTLK",52,0) .S DZ="??" "RTN","DPTLK",53,0) CHKPAT1 .S X=DPTX "RTN","DPTLK",54,0) .D DQ^DICQ "RTN","DPTLK",55,0) ; -- Check for space bar, return "RTN","DPTLK",56,0) I DPTX=" " D G CHKDFN "RTN","DPTLK",57,0) .S Y=$S('($D(DUZ)#2):-1,$D(^DISV(DUZ,"^DPT(")):^("^DPT("),1:-1) "RTN","DPTLK",58,0) .D SETDPT^DPTLK1:Y>0 "RTN","DPTLK",59,0) .S DPTDFN=$S($D(DPTS(Y)):Y,1:-1) "RTN","DPTLK",60,0) ; -- Check for DFN look up "RTN","DPTLK",61,0) I $E(DPTX)="`" D G CHKDFN "RTN","DPTLK",62,0) .S Y=$S($D(^DPT(+$P(DPTX,"`",2),0)):+$P(DPTX,"`",2),1:-1) "RTN","DPTLK",63,0) .D SETDPT^DPTLK1:Y>0 "RTN","DPTLK",64,0) .S DPTDFN=$S($D(DPTS(Y)):Y,1:-1) "RTN","DPTLK",65,0) ; -- Puts input in correct format "RTN","DPTLK",66,0) G CHKDFN:DPTX="" "RTN","DPTLK",67,0) ; -- Force new entry "RTN","DPTLK",68,0) I $E(DPTX)="""",$E(DPTX,$L(DPTX))="""" G NOPAT "RTN","DPTLK",69,0) ; -- Check for EDIPI lookup "RTN","DPTLK",70,0) I DPTX?10N,DIC(0)["M" D G:$G(DPTDFN)>0 CHKDFN "RTN","DPTLK",71,0) .N DGEDIPI "RTN","DPTLK",72,0) .S DGEDIPI=0 F S DGEDIPI=$O(^DGCN(391.91,"AISS",DPTX,"USDOD","NI",+$$IEN^XUAF4("200DOD"),DGEDIPI)) Q:'DGEDIPI I $P($G(^DGCN(391.91,DGEDIPI,2)),"^",3)'="H" Q "RTN","DPTLK",73,0) .Q:DGEDIPI<1 "RTN","DPTLK",74,0) .S Y=$P($G(^DGCN(391.91,DGEDIPI,0)),"^") "RTN","DPTLK",75,0) .D SETDPT^DPTLK1:Y>0 "RTN","DPTLK",76,0) .S DPTDFN=$S($D(DPTS(Y)):Y,1:-1) "RTN","DPTLK",77,0) ; -- Check for index lookups "RTN","DPTLK",78,0) I '$G(DGVIC40)!(DPTX?9N) D ^DPTLK1 G QK:$D(DTOUT)!($D(DUOUT)&(DIC(0)'["A")),ASKPAT:$D(DUOUT),CHKPAT:DPTDFN<0,CHKDFN:DPTDFN>0 I DIC(0)["N",$D(^DPT(DPTX,0)) S Y=X D SETDPT^DPTLK1 S DPTDFN=$S($D(DPTS(Y)):Y,1:-1) G CHKDFN "RTN","DPTLK",79,0) MAG ; -- No patient found, check for mag stripe input, create stub "RTN","DPTLK",80,0) I 'MAG,'BARCODE,'DGCAC G NOPAT "RTN","DPTLK",81,0) ; -- Check for ADT option(s) only "RTN","DPTLK",82,0) N DGOPT "RTN","DPTLK",83,0) S DGOPT=$P($G(XQY0),"^",2) "RTN","DPTLK",84,0) I DGOPT'="Load/Edit Patient Data",DGOPT'="Register a Patient" D G EN2 "RTN","DPTLK",85,0) .W !," ...Patient not in database, use ADT options to load patient" D Q1 "RTN","DPTLK",86,0) ; -- Prompt for creation of stub "RTN","DPTLK",87,0) S DIR(0)="Y",DIR("B")="NO",DIR("A")="Patient not found...Create stub entry: " "RTN","DPTLK",88,0) S GCHK=$D(^TMP("DGVIC")) "RTN","DPTLK",89,0) D ^DIR "RTN","DPTLK",90,0) K DIR "RTN","DPTLK",91,0) I 'Y D Q1 G EN2 "RTN","DPTLK",92,0) ; -- Parse IATA fields "RTN","DPTLK",93,0) D @$S(DGVIC40:"VIC40(.DGFLDS,DGVIC40,DGCAC)",1:"FIELDS(IATA)") "RTN","DPTLK",94,0) I '$D(@DGFLDS) W !,"Could not add patient to patient file" D Q1 G EN2 "RTN","DPTLK",95,0) ; -- Check for Duplicates, no checking if VIC 4.0 card or CAC card "RTN","DPTLK",96,0) D:'$G(DGVIC40) EP2^DPTLK3 "RTN","DPTLK",97,0) ; -- No check done on VIC 4.0 or CAC card, so skip DPTDFN value "RTN","DPTLK",98,0) ; check, file record "RTN","DPTLK",99,0) I 'DGVIC40,DPTDFN<0 D Q1 G EN2 "RTN","DPTLK",100,0) ; -- Creates Stub entry in patient file "RTN","DPTLK",101,0) S Y=$$FILE^DPTLK4(DGFLDS,$G(DGVIC40)) "RTN","DPTLK",102,0) I $P(Y,"^",3)'=1 W !,"Could not add patient to patient file" D QK1 Q "RTN","DPTLK",103,0) D QK1 "RTN","DPTLK",104,0) Q "RTN","DPTLK",105,0) ; "RTN","DPTLK",106,0) NOPAT ; -- No patient found, ask to add new "RTN","DPTLK",107,0) I DIC(0)["L" D ^DPTLK2 S Y=DPTDFN G ASKPAT:DIC(0)["A"&(Y<0)&('$G(DTOUT)),QK1 "RTN","DPTLK",108,0) ; "RTN","DPTLK",109,0) CHKDFN ; -- "RTN","DPTLK",110,0) S:'$D(DPTDFN) DPTDFN=-1 I DPTDFN'>0!('$D(DPTS(+DPTDFN))) W:DIC(0)["Q" *7," ??" G ASKPAT:DIC(0)["A",QK "RTN","DPTLK",111,0) I DIC(0)["E" D W $S('$D(DPTSEL)&('$D(DIVP)):$P(DPTS(DPTDFN),U,2)_" "_$P(DPTS(DPTDFN),U)_" ",$D(^DPT(DPTDFN,0)):" "_$P(^(0),U)_" ",1:"") S Y=DPTDFN X:$D(^DPT(DPTDFN,0)) "N DDS X DIC(""W"")" "RTN","DPTLK",112,0) .I $D(DDS) D CLRMSG^DDS S DX=0,DY=DDSHBX+1 X DDXY "RTN","DPTLK",113,0) ; "RTN","DPTLK",114,0) ; check for other patients in "BS5" xref on Patient file "RTN","DPTLK",115,0) ;I '$G(DICR),DPTDFN>0,DIC(0)["E",$$BS5^DPTLK5(+DPTDFN) D G ASKPAT:DIC(0)["A"&(%'=1),QK:DPTDFN<0 "RTN","DPTLK",116,0) I DPTDFN>0,DIC(0)["E",$$BS5^DPTLK5(+DPTDFN) D G ASKPAT:DIC(0)["A"&(%'=1),QK:DPTDFN<0 ;*TEST* "RTN","DPTLK",117,0) .N DPTZERO,DPTLSNME,DPTSSN S DPTZERO=$G(^DPT(+DPTDFN,0)),DPTLSNME=$P($P(DPTZERO,U),","),DPTSSN=$E($P(DPTZERO,U,9),6,9) "RTN","DPTLK",118,0) .W $C(7),!!,"There is more than one patient whose last name is '",DPTLSNME,"' and" "RTN","DPTLK",119,0) .W !,"whose social security number ends with '",DPTSSN,"'." "RTN","DPTLK",120,0) .W !,"Are you sure you wish to continue (Y/N)" S %=0 D YN^DICN "RTN","DPTLK",121,0) .I %'=1 S DPTDFN=-1 "RTN","DPTLK",122,0) ; "RTN","DPTLK",123,0) ;I '$G(DICR),DPTDFN>0 S Y=DPTDFN D ^DGSEC S DPTDFN=Y G ASKPAT:DIC(0)["A"&(DPTDFN<0),QK:DPTDFN<0 "RTN","DPTLK",124,0) I DPTDFN>0,DIC(0)["E" S Y=DPTDFN D ^DGSEC S DPTDFN=Y G ASKPAT:DIC(0)["A"&(DPTDFN<0),QK:DPTDFN<0 S DPTBTDT=1 "RTN","DPTLK",125,0) S DPTX=DPTX_$P(DPTS(DPTDFN),U,2),DPTDFN=DPTDFN_U_$P(^DPT(DPTDFN,0),U) "RTN","DPTLK",126,0) ; "RTN","DPTLK",127,0) Q ; -- "RTN","DPTLK",128,0) S Y=$S('$D(DPTDFN):-1,'$D(DPTS(+DPTDFN)):-1,1:DPTDFN),X=$S($D(DPTX)&(+Y>0):DPTX,$D(DPTSAVX):DPTSAVX,$D(DPTX):DPTX,1:"") "RTN","DPTLK",129,0) I Y>0 S:DIC(0)'["F" ^DISV($S($D(DUZ)#2:DUZ,1:0),"^DPT(")=+Y S:DIC(0)["Z" Y(0)=^DPT(+Y,0),Y(0,0)=$P(^(0),U,1) "RTN","DPTLK",130,0) ;DG*600 "RTN","DPTLK",131,0) ;I DIC(0)["E",$P($G(^DPT(+Y,0)),U,21) W *7,!,"Warning : You have selected a test patient." "RTN","DPTLK",132,0) I DIC(0)["E",$$TESTPAT^VADPT(+Y) W *7,!,"WARNING : You may have selected a test patient." "RTN","DPTLK",133,0) I DIC(0)["E",$$BADADR^DGUTL3(+Y) W *7,!,"WARNING : ** This patient has been flagged with a Bad Address Indicator." "RTN","DPTLK",134,0) I DIC(0)["E",$$VAADV^DPTLK3(+Y) W *7,!,"** Patient is VA ADVANTAGE." "RTN","DPTLK",135,0) ;DG*485 "RTN","DPTLK",136,0) I $D(^DPT("AXFFP",1,+Y)) D FFP^DPTLK5 "RTN","DPTLK",137,0) ;Display enrollment information "RTN","DPTLK",138,0) I Y>0,DIC(0)["E" D ENR "RTN","DPTLK",139,0) ; "RTN","DPTLK",140,0) ;Call Combat Vet check "RTN","DPTLK",141,0) I Y>0,DIC(0)["E" D CV "RTN","DPTLK",142,0) ; "RTN","DPTLK",143,0) ; check whether to display Means Test Required message "RTN","DPTLK",144,0) D "RTN","DPTLK",145,0) .N DPTDIV "RTN","DPTLK",146,0) .I '$G(DUZ(2)) Q "RTN","DPTLK",147,0) .I Y>0,DIC(0)["E" S DPTDIV=$$DMT^DPTLK5(+Y,DUZ(2)) I DPTDIV D "RTN","DPTLK",148,0) ..W $C(7),!!,"MEANS TEST REQUIRED" "RTN","DPTLK",149,0) ..W !,?3,$P($G(^DG(40.8,DPTDIV,"MT")),U,2) "RTN","DPTLK",150,0) ..H 2 "RTN","DPTLK",151,0) ; "RTN","DPTLK",152,0) Q1 ; -- Clean up variables "RTN","DPTLK",153,0) K D,DIC("W"),DO,DPTCNT,DPTDFN,DPTIFNS,DPTIX,DPTS "RTN","DPTLK",154,0) K:'$G(DICR) DPTBTDT ; IF DICR LEAVE FOR DGSEC TO HANDLE "RTN","DPTLK",155,0) K DPTSAVX,DPTSEL,DPTSZ,DPTX "RTN","DPTLK",156,0) ; "RTN","DPTLK",157,0) K:$D(IATA) IATA "RTN","DPTLK",158,0) K:$D(DGFLDS) @DGFLDS,DGFLDS "RTN","DPTLK",159,0) Q "RTN","DPTLK",160,0) ; "RTN","DPTLK",161,0) QK K:'$D(DPTNOFZK) DPTNOFZY G Q "RTN","DPTLK",162,0) ; "RTN","DPTLK",163,0) QK1 K:'$D(DPTNOFZK) DPTNOFZY G Q1 "RTN","DPTLK",164,0) ; "RTN","DPTLK",165,0) IX ; -- "RTN","DPTLK",166,0) I $D(D),$D(^DD(2,0,"IX",D)),($E(D)'="A") S DPTIX=D "RTN","DPTLK",167,0) G DPTLK "RTN","DPTLK",168,0) ; "RTN","DPTLK",169,0) IATA(X) ; -- "RTN","DPTLK",170,0) ;This function pulls off ssn from the IATA track (old card) "RTN","DPTLK",171,0) ; - If new card, then use card number to look-up DFN, returned as `DFN "RTN","DPTLK",172,0) ; "RTN","DPTLK",173,0) ;Input: X - what was read in "RTN","DPTLK",174,0) ;Output: SSN - social security number OR `DFN if new card "RTN","DPTLK",175,0) ; Q - quit "RTN","DPTLK",176,0) ; "RTN","DPTLK",177,0) ; Track Start Sent End Sent Field Separator "RTN","DPTLK",178,0) ; ----- ---------- -------- --------------- "RTN","DPTLK",179,0) ; IATA (alphanum) % ? { (Note: VA used ^) "RTN","DPTLK",180,0) ; ABA (numeric) ; ? = "RTN","DPTLK",181,0) ; "RTN","DPTLK",182,0) ;N IATA "RTN","DPTLK",183,0) S (IATA)="" "RTN","DPTLK",184,0) I $E(X)'="%" Q X ; no start sentinel "RTN","DPTLK",185,0) I X'["?" Q "Q" "RTN","DPTLK",186,0) ; -- Extract data from track "RTN","DPTLK",187,0) S IATA=$$TRACK(X,"%","?") "RTN","DPTLK",188,0) ; -- checks for no data "RTN","DPTLK",189,0) I IATA="" Q "Q" "RTN","DPTLK",190,0) ; -- checks for new card, look-up DFN "RTN","DPTLK",191,0) I $E(X,1,29)?1"%"9NP1"^"17UNP1"?" S IATA=$$CARD(+$P($P(X,"%",2),"^")) "RTN","DPTLK",192,0) ; -- Returns SSN or `DFN value "RTN","DPTLK",193,0) I IATA'="" Q $P(IATA,"^") "RTN","DPTLK",194,0) Q "Q" "RTN","DPTLK",195,0) ; "RTN","DPTLK",196,0) TRACK(X,START,END) ; find track where start/end are sentinels "RTN","DPTLK",197,0) ; "RTN","DPTLK",198,0) Q $P($P($G(X),START,2),END,1) "RTN","DPTLK",199,0) ; "RTN","DPTLK",200,0) FIELDS(IATA) ; -- Sets fields "RTN","DPTLK",201,0) Q:'$D(IATA) "RTN","DPTLK",202,0) N CNT,FIELD "RTN","DPTLK",203,0) S DGFLDS="^TMP(""DGVIC"","_$J_")",CNT=1 "RTN","DPTLK",204,0) K @DGFLDS "RTN","DPTLK",205,0) F S FIELD=$P($G(IATA),"^",CNT) Q:FIELD="" D "RTN","DPTLK",206,0) .S @DGFLDS@(CNT)=FIELD "RTN","DPTLK",207,0) .S CNT=CNT+1 "RTN","DPTLK",208,0) ; -- Define fields for duplicate checker "RTN","DPTLK",209,0) S DPTX=$G(@DGFLDS@(2)) ;NAME "RTN","DPTLK",210,0) S DPTIDS(.03)=$G(@DGFLDS@(3)) ;DOB "RTN","DPTLK",211,0) S DPTIDS(.09)=$G(@DGFLDS@(1)) ;SSN "RTN","DPTLK",212,0) Q "RTN","DPTLK",213,0) BARCODE(X) ; "RTN","DPTLK",214,0) ;This function pulls off card number from the barcode scan "RTN","DPTLK",215,0) ; looks up the patient (locally) "RTN","DPTLK",216,0) ; if not locally found, queries mpi "RTN","DPTLK",217,0) ; "RTN","DPTLK",218,0) ;Input: X - what was read in "RTN","DPTLK",219,0) ;Output: DFN - `DFN "RTN","DPTLK",220,0) ; Q - quit "RTN","DPTLK",221,0) ; "RTN","DPTLK",222,0) ; Input Start Data VIC ver DoD EDI_PIN VA/VIC II "RTN","DPTLK",223,0) ; -------- ---------- ------- ----------- ---------- "RTN","DPTLK",224,0) ; alphanum % N alphanum 7 alphanum 6 "RTN","DPTLK",225,0) ; "RTN","DPTLK",226,0) N CARD "RTN","DPTLK",227,0) S CARD=$$B32TO10($E(X,10,15)) I 'CARD Q "Q" "RTN","DPTLK",228,0) Q $$CARD(CARD) "RTN","DPTLK",229,0) ; "RTN","DPTLK",230,0) CACCARD(X) ; "RTN","DPTLK",231,0) ;This function pulls off EDIPI number from the CAC barcode scan "RTN","DPTLK",232,0) ; looks up the patient (locally) "RTN","DPTLK",233,0) ; if not locally found, queries mpi "RTN","DPTLK",234,0) ; "RTN","DPTLK",235,0) ;Input: X - what was read in "RTN","DPTLK",236,0) ;Output: DFN - `DFN "RTN","DPTLK",237,0) ; Q - quit "RTN","DPTLK",238,0) ; "RTN","DPTLK",239,0) ; VC PDI PT DoD EDI PC BC CI "RTN","DPTLK",240,0) ; -- --- -- ------- -- --- --- "RTN","DPTLK",241,0) ; "1" 6UN 1U 7UN 1U 1UN 1UN "RTN","DPTLK",242,0) ; "RTN","DPTLK",243,0) N EDIPI "RTN","DPTLK",244,0) S EDIPI=$$B32TO10($E(X,9,15)) I 'EDIPI Q "Q" "RTN","DPTLK",245,0) Q $$EDIPI(EDIPI) "RTN","DPTLK",246,0) ; "RTN","DPTLK",247,0) EDIPI(EDIPI) ; - returns `DFN from EDIPI number "RTN","DPTLK",248,0) N DFN,VICFAC "RTN","DPTLK",249,0) S VICFAC=+$$LKUP^XUAF4("200DOD") ; national DOD station number "RTN","DPTLK",250,0) S DFN=+$G(^DGCN(391.91,+$O(^DGCN(391.91,"ASID",EDIPI,VICFAC,0)),0)) "RTN","DPTLK",251,0) S DGVIC40=EDIPI ; saving EDIPI number here so I don't have to look later "RTN","DPTLK",252,0) I DFN Q "`"_DFN "RTN","DPTLK",253,0) ; - not found locally, need to make sure we don't find anyone DGVIC40 "RTN","DPTLK",254,0) Q "Q" "RTN","DPTLK",255,0) CARD(CARD) ; - returns `DFN from card number "RTN","DPTLK",256,0) N DFN,VICFAC "RTN","DPTLK",257,0) S VICFAC=+$$LKUP^XUAF4("742V1") ; national vic facility number "RTN","DPTLK",258,0) S DFN=+$G(^DGCN(391.91,+$O(^DGCN(391.91,"ASID",CARD,VICFAC,0)),0)) "RTN","DPTLK",259,0) S DGVIC40=CARD ; saving card number here so I don't have to look later "RTN","DPTLK",260,0) I DFN Q "`"_DFN "RTN","DPTLK",261,0) ; - not found locally, need to make sure we don't find anyone DGVIC40 "RTN","DPTLK",262,0) Q "Q" "RTN","DPTLK",263,0) VIC40(DGFLDS,DGVIC40,DGCAC) ; - returns the data used to create the "RTN","DPTLK",264,0) ; patient file entry from mpi "RTN","DPTLK",265,0) N X,DGMPI "RTN","DPTLK",266,0) S DGFLDS="^TMP(""DGVIC"","_$J_")" "RTN","DPTLK",267,0) K @DGFLDS "RTN","DPTLK",268,0) I $T(CARDPV^MPIFXMLS)'="" D CARDPV^MPIFXMLS(.DGMPI,DGVIC40,DGCAC) "RTN","DPTLK",269,0) S X=0 F S X=$O(DGMPI(X)) Q:'X S @DGFLDS@(X)=DGMPI(X) "RTN","DPTLK",270,0) Q "RTN","DPTLK",271,0) ENR ;Display Enrollment information after patient selection "RTN","DPTLK",272,0) N DGENCAT,DGENDFN,DGENR,DGEGTIEN,DGEGT "RTN","DPTLK",273,0) I '$$GET^DGENA($$FINDCUR^DGENA(+DPTDFN),.DGENR) Q "RTN","DPTLK",274,0) S DGENCAT=$$CATEGORY^DGENA4(+DPTDFN) "RTN","DPTLK",275,0) S DGENCAT=$$EXTERNAL^DILFD(27.15,.02,"",DGENCAT) "RTN","DPTLK",276,0) W !?1,"Enrollment Priority: ",$S($G(DGENR("PRIORITY")):$$EXT^DGENU("PRIORITY",DGENR("PRIORITY")),1:""),$S($G(DGENR("SUBGRP"))="":"",1:$$EXT^DGENU("SUBGRP",$G(DGENR("SUBGRP")))) "RTN","DPTLK",277,0) W ?33,"Category: ",DGENCAT "RTN","DPTLK",278,0) W ?57,"End Date: ",$S($G(DGENR("END")):$$FMTE^XLFDT(DGENR("END"),"5DZ"),1:""),! "RTN","DPTLK",279,0) ;If patient is NOT ELIGIBLE, display Enrollment Status (Ineligible Project Phase I) "RTN","DPTLK",280,0) I $G(DGENR("STATUS"))=10!($G(DGENR("STATUS"))=19)!($G(DGENR("STATUS"))=20) D "RTN","DPTLK",281,0) . W ?1,"Enrollment Status: ",$S($G(DGENR("STATUS")):$$EXT^DGENU("STATUS",DGENR("STATUS")),1:"") ;H 5 "RTN","DPTLK",282,0) ;check for Combat Veteran Eligibility, if elig do not display EGT info "RTN","DPTLK",283,0) I $$CVEDT^DGCV(+DPTDFN) Q "RTN","DPTLK",284,0) ;Get Enrollment Group Threshold Priority and Subgroup "RTN","DPTLK",285,0) S DGEGTIEN=$$FINDCUR^DGENEGT "RTN","DPTLK",286,0) S DGEGT=$$GET^DGENEGT(DGEGTIEN,.DGEGT) "RTN","DPTLK",287,0) Q:$G(DGENR("PRIORITY"))=""!($G(DGEGT("PRIORITY"))="") "RTN","DPTLK",288,0) ;Compare Patient's Enrollment Priority to Enrollment Group Threshold "RTN","DPTLK",289,0) I '$$ABOVE^DGENEGT1(+DPTDFN,DGENR("PRIORITY"),$G(DGENR("SUBGRP")),DGEGT("PRIORITY"),DGEGT("SUBGRP")) D "RTN","DPTLK",290,0) .N X,IORVOFF,IORVON "RTN","DPTLK",291,0) .S X="IORVOFF;IORVON" "RTN","DPTLK",292,0) .D ENDR^%ZISS "RTN","DPTLK",293,0) .W !?32 W:$D(IORVON) IORVON W "*** WARNING ***" W:$D(IORVOFF) IORVOFF "RTN","DPTLK",294,0) .I DGENR("END")'="" W !?14 W:$D(IORVON) IORVON W "*** PATIENT ENROLLMENT END",$S(DT>+DGENR("END"):"ED",1:"S")," EFFECTIVE ",$$FMTE^XLFDT(DGENR("END"),"5DZ")," ***" W:$D(IORVOFF) IORVOFF Q "RTN","DPTLK",295,0) .W !?5 W:$D(IORVON) IORVON W "*** PATIENT ENROLLMENT ENDING. ENROLLMENT END DATE IS NOT KNOWN. ***" W:$D(IORVOFF) IORVOFF "RTN","DPTLK",296,0) Q "RTN","DPTLK",297,0) CV ;check for Combat Vet status "RTN","DPTLK",298,0) N DGCV "RTN","DPTLK",299,0) S DGCV=$$CVEDT^DGCV(+DPTDFN) "RTN","DPTLK",300,0) I $P(DGCV,U)=1 D Q "RTN","DPTLK",301,0) . I '$$GET^DGENA($$FINDCUR^DGENA(+DPTDFN),.DGENR) W ! "RTN","DPTLK",302,0) . W ?3,"Combat Vet Status: "_$S($P(DGCV,U,3)=1:"ELIGIBLE",1:"EXPIRED"),?57,"End Date: "_$$FMTE^XLFDT($P(DGCV,U,2),"5DZ") "RTN","DPTLK",303,0) Q "RTN","DPTLK",304,0) B32TO10(X) ; - convert from base 32 to base 10 "RTN","DPTLK",305,0) N I,Y,S S Y=0,S="0123456789ABCDEFGHIJKLMNOPQRSTUV" "RTN","DPTLK",306,0) I X[" " S X=$E(X,1,$F(X," ")-2) "RTN","DPTLK",307,0) F I=1:1:$L(X) S Y=Y*32+($F(S,$E(X,I))-2) "RTN","DPTLK",308,0) Q Y "RTN","DPTLK",309,0) RPCVIC(RETURN,DPTX) ; - patient lookup from VIC card, rpc/api "RTN","DPTLK",310,0) ; non-interactive "RTN","DPTLK",311,0) ; this function will return a patient's DFN based on input. input must "RTN","DPTLK",312,0) ; be in the form of the FULL input from a VIC card (magstripe or bar "RTN","DPTLK",313,0) ; code), the patient must be locally known (FULL doesn't but can contain "RTN","DPTLK",314,0) ; additional card tracks) "RTN","DPTLK",315,0) ; RETURN input should be passed by reference "RTN","DPTLK",316,0) ; "RTN","DPTLK",317,0) ; Input examples: "RTN","DPTLK",318,0) ; Barcode possibilities: "RTN","DPTLK",319,0) ; NNNNNNNNN (old VIC card, full 9 digit ssn) "RTN","DPTLK",320,0) ; CCCCCCCCCCCCCCCCCC (new VIC 4.0 card, 18 characters with "RTN","DPTLK",321,0) ; 10-15 being compressed card number) "RTN","DPTLK",322,0) ; Magstripe possibilities: "RTN","DPTLK",323,0) ; Must always start with % "RTN","DPTLK",324,0) ; Must contain ? "RTN","DPTLK",325,0) ; $E(X,2,10) = SSN (old card) "RTN","DPTLK",326,0) ; %NNNNNNNNN^CCCCCCCCCCCCCCCCC? (first 29 characters) where "RTN","DPTLK",327,0) ; N = card number (new card) "RTN","DPTLK",328,0) ; "RTN","DPTLK",329,0) ; Return (pass by reference): If patient known locally = DFN "RTN","DPTLK",330,0) ; If not known locally = -1 "RTN","DPTLK",331,0) ; "RTN","DPTLK",332,0) N MAG,BARCODE "RTN","DPTLK",333,0) S (RETURN,MAG,BARCODE)=0 "RTN","DPTLK",334,0) I '$D(DPTX) Q -1 "RTN","DPTLK",335,0) I DPTX["?" S DPTX=$E(DPTX,1,$F(DPTX,"?")-1) "RTN","DPTLK",336,0) I DPTX?9N S RETURN=$O(^DPT("SSN",DPTX,0)) "RTN","DPTLK",337,0) I $E(DPTX)="%"!($E(DPTX)=";"),DPTX["?",'RETURN S MAG=1,DPTX=$$IATA(DPTX) "RTN","DPTLK",338,0) I 'MAG,DPTX?1"%"1N13UNP.3UN,'RETURN S BARCODE=1,DPTX=$$BARCODE(DPTX) "RTN","DPTLK",339,0) I 'MAG,'BARCODE,DPTX?1N6UN1U7UN1U2UN S DPTX=$$CACCARD(DPTX) "RTN","DPTLK",340,0) I 'RETURN,$E(DPTX,2,999) S RETURN=$S($E(DPTX)="`":$E(DPTX,2,999),1:$O(^DPT("SSN",DPTX,0))) "RTN","DPTLK",341,0) S RETURN=$S(RETURN:RETURN,1:-1) "RTN","DPTLK",342,0) Q "RTN","DPTLK4") 0^2^B3734144^B1670609 "RTN","DPTLK4",1,0) DPTLK4 ;ALB/JFP - MAS Patient Look-up Create stub entry patient file ; 09/01/96 "RTN","DPTLK4",2,0) ;;5.3;Registration;**73,857**;Aug 13, 1993;Build 8 "RTN","DPTLK4",3,0) FILE(FLDARR,DGVIC40) ; -- Creates stub in patient file "RTN","DPTLK4",4,0) ;Inputs: "RTN","DPTLK4",5,0) ; FLDARR - array of field elements to file "RTN","DPTLK4",6,0) ; DGVIC40 - flag indicating VIC 4.0 card "RTN","DPTLK4",7,0) ;Outputs: "RTN","DPTLK4",8,0) ; 0 - sucess "RTN","DPTLK4",9,0) ; -1^error - "RTN","DPTLK4",10,0) ; "RTN","DPTLK4",11,0) ; *857 made changes to support new vic 4.0 card (elz) "RTN","DPTLK4",12,0) ; "RTN","DPTLK4",13,0) ; -- Check input "RTN","DPTLK4",14,0) Q:'$D(FLDARR) "-1^required parameter not passed" "RTN","DPTLK4",15,0) ; -- New variables "RTN","DPTLK4",16,0) N Y,Z,DIC,SAVY "RTN","DPTLK4",17,0) ; "RTN","DPTLK4",18,0) ; -- Create stub entry in patient file "RTN","DPTLK4",19,0) S DIC="^DPT(",DIC(0)="EL",DLAYGO=2 "RTN","DPTLK4",20,0) ; "RTN","DPTLK4",21,0) ; -- Set X = patient name "RTN","DPTLK4",22,0) S X=$S($G(DGVIC40):$G(@FLDARR@(.01)),1:$G(@FLDARR@(2))) "RTN","DPTLK4",23,0) ; "RTN","DPTLK4",24,0) ; -- if VIC 4.0 card DIR string = "RTN","DPTLK4",25,0) ; SEX;DOB;SSN;POBCity;POBState;MMN;ICN;ICNCheck;MBI "RTN","DPTLK4",26,0) I $G(DGVIC40) S DIC("DR")="",Z=.01 F S Z=$O(@FLDARR@(Z)) Q:'Z S:Z'=991.01&(Z'=991.02) DIC("DR")=DIC("DR")_Z_$S($L(@FLDARR@(Z)):"///"_@FLDARR@(Z),1:"")_";" "RTN","DPTLK4",27,0) ; "RTN","DPTLK4",28,0) ; -- add in other fields for prompt PATIENT TYPE;VETERAN;SC;MBI "RTN","DPTLK4",29,0) I S DIC("DR")=DIC("DR")_"391;1901;.301" "RTN","DPTLK4",30,0) ; "RTN","DPTLK4",31,0) ; -- Set DIR string (old VIC) = SEX;DOB;SSN;PATIENT TYPE;VETERAN;SC "RTN","DPTLK4",32,0) E S DIC("DR")=".02///"_$G(@FLDARR@(4))_";.03///"_$G(@FLDARR@(3))_";.09////"_$G(@FLDARR@(1))_";391///"_$G(@FLDARR@(5))_";1901///"_$G(@FLDARR@(6))_";.301///"_$G(@FLDARR@(7)) "RTN","DPTLK4",33,0) ; "RTN","DPTLK4",34,0) ; -- set date entered into file (missing from prior vic versions) "RTN","DPTLK4",35,0) S DIC("DR")=DIC("DR")_";.097////"_DT "RTN","DPTLK4",36,0) ; "RTN","DPTLK4",37,0) K DD,DO D FILE^DICN S SAVY=Y "RTN","DPTLK4",38,0) K DIC,DLAYGO,X "RTN","DPTLK4",39,0) ; "RTN","DPTLK4",40,0) ; need to update mpi with icn/correlation "RTN","DPTLK4",41,0) I Y>0,$G(@FLDARR@(991.01)),$G(@FLDARR@(991.02)),$T(VIC40^MPIFAPI)'="" D VIC40^MPIFAPI(+Y,@FLDARR@(991.01),@FLDARR@(991.02)) "RTN","DPTLK4",42,0) Q SAVY "RTN","DPTLK4",43,0) ; "VER") 8.0^22.0 "BLD",2918,6) ^765 **END** **END**