DPTLK ;ALB/RMO,RTK - MAS Patient Look-up Main Routine ; 3/22/05 4:19pm
 ;;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,876,915,919**;Aug 13, 1993;Build 4
 ;
 ; mods made for magstripe read 12/96 - JFP
 ; mods made for VIC 4.0 (barcode and magstripe) read 4/2012 - ELZ (*857)
 ;
 ;Optional input: DPTNOFZY='1' to suppress fuzzy lookups implemented
 ;                by patch DG*5.3*244
 ;
EN ; -- Entry point
 
DIE,DR,DGSEARCH,DPTXX
 
DPTX,DPTDFN,DPTSAVX I $D(DIC(0)) QK:DIC(0)["I"!(DIC(0)'["A"&('$D(X)))
 
'$D(^DD("VERSION")) !!?3,"Unable to proceed. Fileman version node ^DD(""VERSION"") is undefined." QK
 
'$D(^DPT(0))!(^DD("VERSION")<17.2) !!?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:""),"." QK
EN2 
DO,DUOUT,DTOUT U="^",DIC="^DPT(",DIC(0)=$S($D(DIC(0)):DIC(0),1:"AELMQ"S:DIC(0)'["A" (DPTX,DPTSAVX)=X
 
DPTSZ=1000 I $D(^DD("OS"))#2 DPTSZ=$S(+$P(^DD("OS",^("OS"),0),U,2):$P(^(0),U,2),1:DPTSZ)
 
;
ASKPAT ; -- Prompt for patient
 
DIC(0)["A" D   G QK:'$T!($E(DPTX)["^")!(DPTX="")
 .
DTOUT,DUOUT,DGNEW,DGSEARCH
 
.!,$S($D(DIC("A")):DIC("A"),1:"Select PATIENT NAME: "W:$D(DIC("B")) DIC("B"),"// "
 
.X:DTIME
 
.(DPTX,DPTXX)=S:'$T DTOUT=1 S:$T&(DPTX="")&($D(DIC("B"))) DPTX=DIC("B"S:DPTX["^"&($E(DPTX)'="%"DUOUT=1
 
; -- Check for the IATA magnetic stripe input
 
MAG,GCHK,BARCODE,DGVIC40,DGCAC
 
(MAG,BARCODE,DGVIC40,DGCAC)=0
 
I $E(DPTX)="%"!($E(DPTX)=";"),DPTX["?" MAG=1,(X,DPTX)=$$IATA(DPTX)
 
'MAG,DPTX?1"%"1N13ANP.3AN BARCODE=1,(X,DPTX)=$$BARCODE($$UP^XLFSTR(DPTX))
 
; - read other line but don't use dbia#10096 don't display input
 
I $G(DGVIC40),'BARCODE ^%ZOSF("EOFF"X(1):1 ^%ZOSF("EON")
 
'MAG,'BARCODE,DPTX?1N6AN1A7AN1A2AN DGCAC=1,(X,DPTX)=$$CACCARD($$UP^XLFSTR(DPTX))
 
; fail VHIC card match but starts with %, we're done
 
'MAG,'BARCODE,'DGCAC,$E(DPTX,1)="%" CHKDFN
 
;
CHKPAT ; -- Custom Patient Lookup
 
DO^DIC1
 
DIC("W")=$S($D(DIC("W")):DIC("W"),1:"")
 
DPTIFNS,DPTS,DPTSEL
 
DPTCNT=0
 
; -- Check input for format an length
 
CHKDFN:DPTX?1A!(DPTX'?.ANP)!($L(DPTX)>30)&('$G(DGVIC40))
 
; -- Check for null response or abort
 
DPTX=""!(DPTX["^"ASKPAT:DIC(0)["A",QK
 
; -- Check for question mark
 
DPTX["?" D  G ASKPAT:DIC(0)["A",QK
 
.D="B"
 
.DZ=$S(DPTX?1"?":"",1:"??")
 .
CHKPAT1:DZ="??"
 
.%
 
.!,?1,"Answer with PATIENT NAME, or SOCIAL SECURITY NUMBER, or last 4 digits",!,?4,"of SOCIAL SECURITY NUMBER, or first initial of"
 
." last name with last",!,?4,"4 digits of SOCIAL SECURITY NUMBER"
 
.!,?1,"Do you want the entire ",+$P($G(^DPT(0)),"^",4),"-Entry PATIENT List" %=0 YN^DICN
 .
Q:%'=1
 .
DZ="??"
CHKPAT1 .X=DPTX
 
.DQ^DICQ
 
; -- Check for space bar, return
 
DPTX=" " D  G CHKDFN
 
.Y=$S('($D(DUZ)#2):-1,$D(^DISV(DUZ,"^DPT(")):^("^DPT("),1:-1)
 .
SETDPT^DPTLK1:Y>0
 .
DPTDFN=$S($D(DPTS(Y)):Y,1:-1)
 
; -- Check for DFN look up
 
I $E(DPTX)="`" D  G CHKDFN
 
.Y=$S($D(^DPT(+$P(DPTX,"`",2),0)):+$P(DPTX,"`",2),1:-1)
 .
SETDPT^DPTLK1:Y>0
 .
DPTDFN=$S($D(DPTS(Y)):Y,1:-1)
 
; -- Puts input in correct format
 
CHKDFN:DPTX=""
 ; -- Force new entry
 
I $E(DPTX)="""",$E(DPTX,$L(DPTX))="""" NOPAT
 
; -- Check for EDIPI lookup
 
DPTX?10N,DIC(0)["M" D  G:$G(DPTDFN)>0 CHKDFN
 
.DGEDIPI
 
.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
 
.Q:DGEDIPI<1
 .
Y=$P($G(^DGCN(391.91,DGEDIPI,0)),"^")
 .
SETDPT^DPTLK1:Y>0
 .
DPTDFN=$S($D(DPTS(Y)):Y,1:-1)
 
; -- Check for index lookups
 
'$G(DGVIC40)!(DPTX?9N^DPTLK1  D  G QK:$D(DTOUT)!($D(DUOUT)&(DIC(0)'["A")),ASKPAT:$D(DUOUT),CHKPAT:DPTDFN<0,CHKDFN:DPTDFN>0 DIC(0)["N",$D(^DPT(DPTX,0)) Y=SETDPT^DPTLK1 DPTDFN=$S($D(DPTS(Y)):Y,1:-1) CHKDFN
 
DPTDFN<1,$P($G(XQY0),"^",2)="Register a Patient",$T(PATIENT^MPIFXMLP)'="",'MAG D
 
.. DPTDFN=$$SEARCH^DPTLK7(DPTX,$G(DPTXX))
 .. 
DPTDFN<1 DO,D,DIC("W"),DPTCNT,DPTS,DPTSEL,DPTSZ DPTDFN=-1,Y=-1,(DPTX,DPTXX)=""
 
.. DPTSZ=1000 I $D(^DD("OS"))#2 DPTSZ=$S(+$P(^DD("OS",^("OS"),0),U,2):$P(^(0),U,2),1:DPTSZ)
 .. 
S:DPTDFN>0 DPTS(DPTDFN)=$P(^DPT(DPTDFN,0),"^")_"^"_$P(^DPT(DPTDFN,0),"^")
MAG ; -- No patient found, check for mag stripe input, create stub
 
'MAG,'BARCODE,'DGCAC NOPAT
 
; -- Check for ADT option(s) only
 
DGOPT
 
DGOPT=$P($G(XQY0),"^",2)
 
DGOPT'="Load/Edit Patient Data",DGOPT'="Register a Patient" D  G EN2
 
.!,"    ...Patient not in database, use ADT options to load patient" Q1
 
; -- Prompt for creation of stub
 
DIR(0)="Y",DIR("B")="NO",DIR("A")="Patient not found...Create stub entry: "
 
GCHK=$D(^TMP("DGVIC"))
 
^DIR
 
DIR
 
'Q1 EN2
 
; -- Parse IATA fields
 
@$S(DGVIC40:"VIC40(.DGFLDS,DGVIC40,DGCAC)",1:"FIELDS(IATA)")
 
'$D(@DGFLDS!,"Could not add patient to patient file" Q1 EN2
 
; -- Check for Duplicates, no checking if VIC 4.0 card or CAC card
 
D:'$G(DGVIC40EP2^DPTLK3
 
; -- No check done on VIC 4.0 or CAC card, so skip DPTDFN value
 ;    check, file record
 
'DGVIC40,DPTDFN<0 Q1 EN2
 
; -- Creates Stub entry in patient file
 
Y=$$FILE^DPTLK4(DGFLDS,$G(DGVIC40))
 
I $P(Y,"^",3)'=1 !,"Could not add patient to patient file" QK1 Q
 D 
QK1
 
Q
 
;
NOPAT ; -- No patient found, ask to add new
 
DIC(0)["L" ^DPTLK2 Y=DPTDFN ASKPAT:DIC(0)["A"&(Y<0)&('$G(DTOUT)),QK1
 
;
CHKDFN ; -- 
 
S:'$D(DPTDFNDPTDFN=-1 DPTDFN'>0!('$D(DPTS(+DPTDFN))) W:DIC(0)["Q" *7," ??" ASKPAT:DIC(0)["A",QK
 
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:""Y=DPTDFN X:$D(^DPT(DPTDFN,0)) "N DDS X DIC(""W"")"
 
.I $D(DDSCLRMSG^DDS DX=0,DY=DDSHBX+1 DDXY
 
;
 ; check for other patients in "BS5" xref on Patient file
 ;I '$G(DICR),DPTDFN>0,DIC(0)["E",$$BS5^DPTLK5(+DPTDFN) D  G ASKPAT:DIC(0)["A"&(%'=1),QK:DPTDFN<0
 
DPTDFN>0,DIC(0)["E",$$BS5^DPTLK5(+DPTDFN),'$D(DGSEARCHD  G ASKPAT:DIC(0)["A"&(%'=1),QK:DPTDFN<0  ;*TEST*
 
.DPTZERO,DPTLSNME,DPTSSN DPTZERO=$G(^DPT(+DPTDFN,0)),DPTLSNME=$P($P(DPTZERO,U),","),DPTSSN=$E($P(DPTZERO,U,9),6,9)
 .
W $C(7),!!,"There is more than one patient whose last name is '",DPTLSNME,"' and"
 
.!,"whose social security number ends with '",DPTSSN,"'."
 
.!,"Are you sure you wish to continue (Y/N)" %=0 YN^DICN
 .
%'=1 DPTDFN=-1
 
;
 ;I '$G(DICR),DPTDFN>0 S Y=DPTDFN D ^DGSEC S DPTDFN=Y G ASKPAT:DIC(0)["A"&(DPTDFN<0),QK:DPTDFN<0
 
DPTDFN>0,DIC(0)["E" Y=DPTDFN ^DGSEC DPTDFN=ASKPAT:DIC(0)["A"&(DPTDFN<0),QK:DPTDFN<0 DPTBTDT=1
 
DPTX=DPTX_$P(DPTS(DPTDFN),U,2),DPTDFN=DPTDFN_U_$P(^DPT(DPTDFN,0),U)
 
;
; -- 
 
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:"")
 
Y>0 S:DIC(0)'["F" ^DISV($S($D(DUZ)#2:DUZ,1:0),"^DPT(")=+S:DIC(0)["Z" Y(0)=^DPT(+Y,0),Y(0,0)=$P(^(0),U,1)
 
;DG*600
 
DIC(0)["E",$$TESTPAT^VADPT(+Y*7,!,"WARNING : You may have selected a test patient."
 
DIC(0)["E",$$BADADR^DGUTL3(+Y*7,!,"WARNING : ** This patient has been flagged with a Bad Address Indicator."
 
DIC(0)["E",$$VAADV^DPTLK3(+Y*7,!,"** Patient is VA ADVANTAGE."
 ;DG*485
 
I $D(^DPT("AXFFP",1,+Y)) FFP^DPTLK5
 
;Display enrollment information
 
Y>0,DIC(0)["E" ENR
 
;
 ;Call Combat Vet check
 
Y>0,DIC(0)["E" CV
 
;
 ; check whether to display Means Test Required message
 
D
 
.DPTDIV
 
.'$G(DUZ(2)) Q
 
.Y>0,DIC(0)["E" DPTDIV=$$DMT^DPTLK5(+Y,DUZ(2)) DPTDIV D
 
..W $C(7),!!,"MEANS TEST REQUIRED"
 
..!,?3,$P($G(^DG(40.8,DPTDIV,"MT")),U,2)
 ..
2
 
;
Q1 ; -- Clean up variables
 
D,DIC("W"),DO,DPTCNT,DPTDFN,DPTIFNS,DPTIX,DPTS
 
K:'$G(DICRDPTBTDT  ; IF DICR LEAVE FOR DGSEC TO HANDLE
 
DPTSAVX,DPTSEL,DPTSZ,DPTX
 
;
 
K:$D(IATAIATA
 
K:$D(DGFLDS) @DGFLDS,DGFLDS
 
Q
 
;
QK K:'$D(DPTNOFZKDPTNOFZY Q
 
;
QK1 K:'$D(DPTNOFZKDPTNOFZY Q1
 
;
IX ; --
 
I $D(D),$D(^DD(2,0,"IX",D)),($E(D)'="A"DPTIX=D
 
DPTLK
 
;
IATA(X) ; --
 ;This function pulls off ssn from the IATA track (old card)
 ; - If new card, then use card number to look-up DFN, returned as `DFN
 ;
 ;Input:  X   -  what was read in
 ;Output: SSN -  social security number OR `DFN if new card
 ;          Q -  quit
 ;
 ; Track            Start Sent     End Sent      Field Separator
 ; -----            ----------     --------      ---------------
 ;  IATA (alphanum)      %             ?          {   (Note: VA used ^)
 ;  ABA (numeric)        ;             ?          =    
 ;
 ;N IATA
 
(IATA)=""
 
I $E(X)'="%" ; no start sentinel
 
X'["?" "Q"
 ; -- Extract data from track
 
IATA=$$TRACK(X,"%","?")
 
; -- checks for no data
 
IATA="" "Q"
 ; -- checks for new card, look-up DFN
 
I $E(X,1,29)?1"%"9NP1"^"17UNP1"?" D
 
CARD
 
CARD=+$P($P(X,"%",2),"^")
 . 
; **919, Story 220135 (elz) log the card activity
 
CARDLOG^MPIFAPI(CARD,"VHIC","SWIPE")
 . 
IATA=$$CARD(CARD)
 
; -- Returns SSN or `DFN value
 
IATA'="" Q $P(IATA,"^")
 
"Q"
 ;
TRACK(X,START,END) ; find track where start/end are sentinels
 ;
 
Q $P($P($G(X),START,2),END,1)
 
;
FIELDS(IATA) ; -- Sets fields
 
Q:'$D(IATA)
 
CNT,FIELD
 
DGFLDS="^TMP(""DGVIC"","_$J_")",CNT=1
 
@DGFLDS
 
F  S FIELD=$P($G(IATA),"^",CNT)  Q:FIELD=""  D
 
.@DGFLDS@(CNT)=FIELD
 
.CNT=CNT+1
 
; -- Define fields for duplicate checker
 
DPTX=$G(@DGFLDS@(2)) ;NAME
 
DPTIDS(.03)=$G(@DGFLDS@(3)) ;DOB
 
DPTIDS(.09)=$G(@DGFLDS@(1)) ;SSN
 
Q
BARCODE(X) ;
 ;This function pulls off card number from the barcode scan
 ;  looks up the patient (locally)
 ;  if not locally found, queries mpi 
 ;
 ;Input:  X   -  what was read in
 ;Output: DFN -  `DFN
 ;          Q -  quit
 ;
 ; Input       Start Data   VIC ver     DoD EDI_PIN     VA/VIC II   
 ; --------    ----------   -------     -----------     ----------
 ; alphanum        %           N         alphanum 7     alphanum 6
 ;
 
CARD
 
CARD=$$B32TO10($E(X,10,15)) 'CARD "Q"
 ; **919, Story 220135 (elz) log the card activity
 
CARDLOG^MPIFAPI(CARD,"VHIC","SCAN")
 
Q $$CARD(CARD)
 
;
CACCARD(X) ;
 ;This function pulls off EDIPI number from the CAC barcode scan
 ;  looks up the patient (locally)
 ;  if not locally found, queries mpi 
 ;
 ;Input:  X   -  what was read in
 ;Output: DFN -  `DFN
 ;          Q -  quit
 ;
 ; VC     PDI     PT       DoD EDI   PC     BC      CI
 ; --     ---     --       -------   --     ---     ---
 ; "1"    6UN     1U         7UN     1U     1UN     1UN
 ;
 
EDIPI
 
EDIPI=$$B32TO10($E(X,9,15)) 'EDIPI "Q"
 
Q $$EDIPI(EDIPI)
 
;
EDIPI(EDIPI) ; - returns `DFN from EDIPI number
 
DFN,VICFAC
 
; **919, Story 220135 (elz) log the card activity
 
CARDLOG^MPIFAPI(EDIPI,"CAC","SCAN")
 
VICFAC=+$$LKUP^XUAF4("200DOD"; national DOD station number
 
DFN=+$G(^DGCN(391.91,+$O(^DGCN(391.91,"ASID",EDIPI,VICFAC,0)),0))
 
DGVIC40=EDIPI ; saving EDIPI number here so I don't have to look later
 
DFN "`"_DFN
 
; - not found locally, need to make sure we don't find anyone DGVIC40
 
"Q"
CARD(CARD) ; - returns `DFN from card number
 
DFN,VICFAC
 
VICFAC=+$$LKUP^XUAF4("742V1"; national vic facility number
 
DFN=+$G(^DGCN(391.91,+$O(^DGCN(391.91,"ASID",CARD,VICFAC,0)),0))
 
DGVIC40=CARD ; saving card number here so I don't have to look later
 
DFN "`"_DFN
 
; - not found locally, need to make sure we don't find anyone DGVIC40
 
"Q"
VIC40(DGFLDS,DGVIC40,DGCAC) ; - returns the data used to create the
 ;  patient file entry from mpi
 
X,DGMPI
 
DGFLDS="^TMP(""DGVIC"","_$J_")"
 
@DGFLDS
 
I $T(CARDPV^MPIFXMLS)'="" CARDPV^MPIFXMLS(.DGMPI,DGVIC40,DGCAC)
 
X=0 F  S X=$O(DGMPI(X)) Q:'X  @DGFLDS@(X)=DGMPI(X)
 
Q
ENR ;Display Enrollment information after patient selection
 
DGENCAT,DGENDFN,DGENR,DGEGTIEN,DGEGT
 
'$$GET^DGENA($$FINDCUR^DGENA(+DPTDFN),.DGENRQ
 S 
DGENCAT=$$CATEGORY^DGENA4(+DPTDFN)
 
DGENCAT=$$EXTERNAL^DILFD(27.15,.02,"",DGENCAT)
 
!?1,"Enrollment Priority: ",$S($G(DGENR("PRIORITY")):$$EXT^DGENU("PRIORITY",DGENR("PRIORITY")),1:""),$S($G(DGENR("SUBGRP"))="":"",1:$$EXT^DGENU("SUBGRP",$G(DGENR("SUBGRP"))))
 
?33,"Category: ",DGENCAT
 
?57,"End Date: ",$S($G(DGENR("END")):$$FMTE^XLFDT(DGENR("END"),"5DZ"),1:""),!
 
;If patient is NOT ELIGIBLE, display Enrollment Status (Ineligible Project Phase I)
 
I $G(DGENR("STATUS"))=10!($G(DGENR("STATUS"))=19)!($G(DGENR("STATUS"))=20) D
 
?1,"Enrollment Status: ",$S($G(DGENR("STATUS")):$$EXT^DGENU("STATUS",DGENR("STATUS")),1:"";H 5
 ;check for Combat Veteran Eligibility, if elig do not display EGT info
 
I $$CVEDT^DGCV(+DPTDFNQ
 
;Get Enrollment Group Threshold Priority and Subgroup
 
DGEGTIEN=$$FINDCUR^DGENEGT
 
DGEGT=$$GET^DGENEGT(DGEGTIEN,.DGEGT)
 
Q:$G(DGENR("PRIORITY"))=""!($G(DGEGT("PRIORITY"))="")
 
;Compare Patient's Enrollment Priority to Enrollment Group Threshold
 
'$$ABOVE^DGENEGT1(+DPTDFN,DGENR("PRIORITY"),$G(DGENR("SUBGRP")),DGEGT("PRIORITY"),DGEGT("SUBGRP")) D
 
.X,IORVOFF,IORVON
 
.X="IORVOFF;IORVON"
 
.ENDR^%ZISS
 .
!?32 W:$D(IORVONIORVON  "*** WARNING ***" W:$D(IORVOFFIORVOFF
 
.DGENR("END")'="" !?14 W:$D(IORVONIORVON "*** PATIENT ENROLLMENT END",$S(DT>+DGENR("END"):"ED",1:"S")," EFFECTIVE ",$$FMTE^XLFDT(DGENR("END"),"5DZ")," ***" W:$D(IORVOFFIORVOFF Q
 
.!?5 W:$D(IORVONIORVON "*** PATIENT ENROLLMENT ENDING.  ENROLLMENT END DATE IS NOT KNOWN. ***" W:$D(IORVOFFIORVOFF
 
Q
CV ;check for Combat Vet status
 
DGCV
 
DGCV=$$CVEDT^DGCV(+DPTDFN)
 
I $P(DGCV,U)=1 D  Q
 
'$$GET^DGENA($$FINDCUR^DGENA(+DPTDFN),.DGENR!
 . 
?3,"Combat Vet Status: "_$S($P(DGCV,U,3)=1:"ELIGIBLE",1:"EXPIRED"),?57,"End Date: "_$$FMTE^XLFDT($P(DGCV,U,2),"5DZ")
 
Q
B32TO10(X) ; - convert from base 32 to base 10
 
I,Y,Y=0,S="0123456789ABCDEFGHIJKLMNOPQRSTUV"
 
X[" " X=$E(X,1,$F(X," ")-2)
 
I=1:1:$L(XY=Y*32+($F(S,$E(X,I))-2)
 
Y
RPCVIC(RETURN,DPTX) ; - patient lookup from VIC card, rpc/api
 ; non-interactive
 ; this function will return a patient's DFN based on input.  input must
 ; be in the form of the FULL input from a VIC card (magstripe or bar
 ; code), the patient must be locally known (FULL doesn't but can contain
 ; additional card tracks)
 ; RETURN input should be passed by reference
 ;
 ;  Input examples:
 ;     Barcode possibilities:
 ;            NNNNNNNNN (old VIC card, full 9 digit ssn)
 ;            CCCCCCCCCCCCCCCCCC (new VIC 4.0 card, 18 characters with
 ;                                10-15 being compressed card number)
 ;     Magstripe possibilities:
 ;            Must always start with %
 ;            Must contain ?
 ;            $E(X,2,10) = SSN (old card)
 ;            %NNNNNNNNN^CCCCCCCCCCCCCCCCC? (first 29 characters) where
 ;                                          N = card number (new card)
 ;
 ;  Return (pass by reference):  If patient known locally = DFN
 ;                                   If not known locally = -1
 ;
 
MAG,BARCODE
 
(RETURN,MAG,BARCODE)=0
 
'$D(DPTX-1
 
DPTX=$$UP^XLFSTR(DPTX)
 
DPTX["?" DPTX=$E(DPTX,1,$F(DPTX,"?")-1)
 
DPTX?9RETURN=$O(^DPT("SSN",DPTX,0))
 
I $E(DPTX)="%"!($E(DPTX)=";"),DPTX["?",'RETURN MAG=1,DPTX=$$IATA(DPTX)
 
'MAG,DPTX?1"%"1N13UNP.3UN,'RETURN BARCODE=1,DPTX=$$BARCODE(DPTX)
 
'MAG,'BARCODE,DPTX?1N6UN1U7UN1U2UN DPTX=$$CACCARD(DPTX)
 
'RETURN,$E(DPTX,2,999) RETURN=$S($E(DPTX)="`":$E(DPTX,2,999),1:$O(^DPT("SSN",DPTX,0)))
 
RETURN=$S(RETURN:RETURN,1:-1)
 
Q