DGQPTQ5 ; SLC/PKS - Functions for Patient Selection Lists. ; 6/5/01 12:37pm
;;5.3;Registration;**447,1015**;Aug 13, 1993;Build 21
;
Q
;
COMBDISP(DGQDUZ,DGQPTR) ; Display user's "Combination" pt selection sources.
;
; Variables used:
;
; DGQCNT = Counter for number of entries displayed.
; DGQDUZ = DUZ of user involved.
; DGQPTR = IEN for user's OE/RR PT SEL COMBO file entries.
; DGQSRC = $O command values from combo entries, file ^OR(100.24,.
; DGQTXT = Text name string for combo entry pointers.
;
N DGQCNT,DGQSRC,DGQTXT
;
; Check passed variables, punt on errors:
S DGQCNT=0
I '($D(DGQDUZ)) W !,"No user DUZ passed.",! Q DGQCNT
I '($D(DGQPTR)) W !,"No combination pointer passed.",! Q DGQCNT
I DGQDUZ="" W !,"No user DUZ passed.",! Q DGQCNT
I DGQPTR="" W !,"No combination pointer passed.",! Q DGQCNT
;
; Order through the user's combination source entries:
K ^TMP("DG",$J,"DGQCPL")
S DGQSRC=0
F S DGQSRC=$O(^OR(100.24,DGQPTR,.01,DGQSRC)) Q:'ORQSRC D
.;
.; Get the actual source name based on the pointer entry value:
.S DGQTXT=""
.S DGQTXT=$G(^OR(100.24,DGQPTR,.01,DGQSRC,0))
.I '(DGQTXT="") D
..S DGQCNT=DGQCNT+1 ; Increment counter.
..S DGQTXT=$$COMBNM(DGQTXT) ; Call tag to create complete string.
..;
..; Write to ^TMP file for sorting:
..I DGQTXT'="" S ^TMP("DG",$J,"DGQCPL",$P(DGQTXT,U))=$P(DGQTXT,U,2)
;
; Write data to the screen:
I DGQCNT D ; Data to write?
.S DGQTXT="" ; Reset, re-use.
.F S DGQTXT=$O(^TMP("DG",$J,"DGQCPL",DGQTXT)) Q:DGQTXT="" D
..W !,$G(^TMP("DG",$J,"DGQCPL",DGQTXT))
;
K ^TMP("OR",$J,"DGQCPL") ; Clean house.
;
Q DGQCNT ; Return counter.
;
COMBNM(DGQVAL) ; Returns name of "Combination" source entry, ^OR(100.24 file.
;
; Returned string is "X^Name^String" where X is letter of type,
; Name is name of entity, and String resembles examples below:
;
; W_1W^Ward: 1W SURGERY WEST
; P_JONES,WILMA MD^Provider: JONES,WILMA MD
; T_SURGERYLIST2^Team List: SURGERYLIST2
; (Etc.)
;
; Variables used:
;
; DGQFILE = File for retrieval of name.
; DGQPTR = Name string to return.
; DGQRTN = Value returned by this function.
; DGQVAL = Combo source entry pointer.
;
N DGQPTR,DGQFILE,DGQRTN
I '($D(DGQVAL)) Q DGQRTN ; Error - punt.
;
S DGQRTN="No source found...." ; Default init.
S DGQPTR=$P(DGQVAL,";") ; Get pointer.
S DGQFILE="^"_$P(DGQVAL,";",2) ; Get file.
;
I DGQFILE="^DIC(42," D Q DGQRTN ; Wards.
.S DGQRTN=$G(^DIC(42,DGQPTR,0))
.I $D(DGQRTN) S DGQRTN="W"_"_"_$P(DGQRTN,U)_U_"Ward: "_$P(DGQRTN,U)_" "_$P(DGQRTN,U,2)
;
I DGQFILE="^VA(200," D Q DGQRTN ; Providers.
.S DGQRTN=$G(^VA(200,DGQPTR,0))
.I $D(DGQRTN) S DGQRTN="P"_"_"_$P(DGQRTN,U)_U_"Provider: "_$P(DGQRTN,U)
;
I DGQFILE="^DIC(45.7," D Q DGQRTN ; Specialties.
.S DGQRTN=$G(^DIC(45.7,DGQPTR,0))
.I $D(DGQRTN) S DGQRTN="S"_"_"_$P(DGQRTN,U)_U_"Specialty: "_$P(DGQRTN,U)
;
I DGQFILE="^OR(100.21," D Q DGQRTN ; Team Lists.
.S DGQRTN=$G(^OR(100.21,DGQPTR,0))
.I $D(DGQRTN) S DGQRTN="T"_"_"_$P(DGQRTN,U)_U_"Team List: "_$P(DGQRTN,U)
;
I DGQFILE="^SC(" D Q DGQRTN ; Clinics.
.S DGQRTN=$G(^SC(DGQPTR,0))
.I $D(DGQRTN) S DGQRTN="C"_"_"_$P(DGQRTN,U)_U_"Clinic: "_$P(DGQRTN,U)
;
; Return value (null will be returned if nothing matched):
Q DGQRTN
;
PTSCOMBO(DGQTYP,DGQPTR) ; Write ^TMP("DG",$J,"PATIENTS","B") patient entries.
;
; Called from COMBPTS^DGQPTQ6.
; (DGQCNT,DGQPDAT,DGQPIEN,DGQPNM,SORT new'd in calling code.)
; (Array DGY new'd in calling routine DGQPTQ2.)
;
; Variables used:
;
; DGQDOB = Patient DOB.
; DGQDONE = Flag for end of patient records.
; DGQIDT = Clinic app't date stored in internal format.
; DGQMORE = Room/bed or appointment information.
; DGQPTR = PASSED: Pointer from subfile entry, combination file.
; DGQSNM = Name of source from subfile entry pointer.
; DGQSNM4 = First four letters of name of source.
; DGQSSN = Patient SSN suffix.
; DGQTYP = PASSED: Holds source type:
;
; W = Ward
; P = Provider
; S = Specialty
; T = Team List
; C = Clinic
;
N DGQDOB,DGQDONE,DGQIDT,DGQMORE,DGQSNM,DGQSNM4,DGQSSN
;
; Initialize variables:
S DGQDONE=0
S DGQCNT=1
;
; Get name data for source:
S DGQSNM4="" ; Default setting.
I DGQTYP="W" S DGQSNM4=$G(^DIC(42,DGQPTR,0)) ; Wards.
I DGQTYP="P" S DGQSNM4=$G(^VA(200,DGQPTR,0)) ; Providers.
I DGQTYP="S" S DGQSNM4=$G(^DIC(45.7,DGQPTR,0)) ; Specialties.
I DGQTYP="T" S DGQSNM4=$G(^OR(100.21,DGQPTR,0)) ; Team Lists.
I DGQTYP="C" S DGQSNM4=$G(^SC(DGQPTR,0)) ; Clinics.
;
; Assure use of first 4 letters of name:
S DGQSNM4=$P(DGQSNM4,U)_" " ; Add 4 for safety.
S DGQSNM4=$E(DGQSNM4,1,4) ; Get first 4 only.
;
; Add label prefix to source name:
S DGQSNM="" ; Default setting.
S DGQSNM=$S(DGQTYP="W":"Wd ",DGQTYP="P":"Pr ",DGQTYP="S":"Sp ",DGQTYP="T":"Tm ",DGQTYP="C":"Cl ",1:" ") ; Get correct name.
S DGQSNM=DGQSNM_DGQSNM4 ; Prepend label.
;
; Order thru DGY array created by calls in calling routine:
S DGQPDAT="" ; Initialize.
F S DGQPDAT=$G(DGY(DGQCNT)) Q:((DGQPDAT="")!(DGQDONE)) D
.;
.; Clear variables each time:
.S (DGQPIEN,DGQPNM,DGQSSN,DGQDOB,DGQIDT,DGQMORE)=""
.;
.S DGQPIEN=$P(DGQPDAT,U) ; Get patient IEN.
.I DGQPIEN="" S DGQDONE=1 Q ; Punt if no IEN.
.S DGQPNM=$P(DGQPDAT,U,2) ; Get patient name.
.;
.; Get patient SSN suffix:
.S DGQSSN=$$ID($G(DGQPIEN))
.;
.; Get patient DOB:
.S DGQDOB=$$FMTE^XLFDT($P($G(^DPT(DGQPIEN,0)),U,3))
.;
.; Get patient room/bed information where data exists:
.S DGQMORE=$P($G(^DPT(DGQPIEN,.101)),U)
.;
.; Assure at least 4 letters for any existing room/bed data:
.I DGQMORE'="" D ; Any data now?
..I $L(DGQMORE)<4 D ; Less than 4 now?
...S DGQMORE=DGQMORE_" " ; Add 3 for safety.
...S DGQMORE=$E(DGQMORE,1,4) ; Get first 4 only.
.;
.; Get clinic appointment information, if applicable:
.I DGQTYP="C" D
..S DGQMORE="" ; Reset, re-use.
..S DGQMORE=$P(DGQPDAT,U,4) ; App't data.
..S DGQIDT=DGQMORE ; Internal format.
..S $P(DGQMORE,".",2)=$E($P(DGQMORE,".",2)_"000",1,4)
..S DGQMORE=$$FMTE^XLFDT($P(DGQMORE,U)) ; Format app't.
.;
.; Write a sorted entry in ^TMP("DG",$J,"PATIENTS","B"):
.; (Node's data:)
.; (DFN^PtName^SSN^DOB^SourceName^App't/Room/Bed^SourceIEN)
.I DGQPIEN'="" D
..;
..; Write using source name first if sorted by "S" (source) -or-
..; if "P" (app't) sort and not a clinic:
..I ((SORT="S")!((SORT="P")&(DGQTYP'="C"))) D Q
...S ^TMP("DG",$J,"PATIENTS","B",DGQSNM_" "_DGQPNM_" "_DGQPIEN_" "_DGQIDT)=DGQPIEN_U_DGQPNM_U_DGQSSN_U_DGQDOB_U_DGQSNM_U_DGQMORE_U_DGQPTR_U_DGQIDT
..;
..; Use source source+app't first if "P" (app't) sort, and a clinic:
..I ((DGQTYP="C")&(SORT="P")) D Q
...S ^TMP("DG",$J,"PATIENTS","B",DGQSNM_" "_DGQIDT_" "_DGQPNM_" "_DGQPIEN)=DGQPIEN_U_DGQPNM_U_DGQSSN_U_DGQDOB_U_DGQSNM_U_DGQMORE_U_DGQPTR_U_DGQIDT
..;
..; If not by source or source/app't, default to alpha ("A") sort:
..S ^TMP("DG",$J,"PATIENTS","B",DGQPNM_" "_DGQPIEN_" "_DGQSNM_" "_DGQIDT)=DGQPIEN_U_DGQPNM_U_DGQSSN_U_DGQDOB_U_DGQSNM_U_DGQMORE_U_DGQPTR_U_DGQIDT
.;
.S DGQCNT=DGQCNT+1 ; Increment counter.
;
Q
;
ID(DGQPIEN) ; Return short ID for patient ID.
; (Copied from DGQPT routine and modified.)
;
N ID
;
S ID=$P($G(^DPT(DGQPIEN,.36)),U,4) ; Gets short ID.
I '$L(ID) D ; - or -
.S ID=$E($P($G(^DPT(DGQPIEN,0)),U,9),6,9) ; Last 4 of SSN
;
Q "("_$E(DGQPNM)_ID_")"
;
DGQPTQ5 ; SLC/PKS - Functions for Patient Selection Lists. ; 6/5/01 12:37pm
+1 ;;5.3;Registration;**447,1015**;Aug 13, 1993;Build 21
+2 ;
+3 QUIT
+4 ;
COMBDISP(DGQDUZ,DGQPTR) ; Display user's "Combination" pt selection sources.
+1 ;
+2 ; Variables used:
+3 ;
+4 ; DGQCNT = Counter for number of entries displayed.
+5 ; DGQDUZ = DUZ of user involved.
+6 ; DGQPTR = IEN for user's OE/RR PT SEL COMBO file entries.
+7 ; DGQSRC = $O command values from combo entries, file ^OR(100.24,.
+8 ; DGQTXT = Text name string for combo entry pointers.
+9 ;
+10 NEW DGQCNT,DGQSRC,DGQTXT
+11 ;
+12 ; Check passed variables, punt on errors:
+13 SET DGQCNT=0
+14 IF '($DATA(DGQDUZ))
WRITE !,"No user DUZ passed.",!
QUIT DGQCNT
+15 IF '($DATA(DGQPTR))
WRITE !,"No combination pointer passed.",!
QUIT DGQCNT
+16 IF DGQDUZ=""
WRITE !,"No user DUZ passed.",!
QUIT DGQCNT
+17 IF DGQPTR=""
WRITE !,"No combination pointer passed.",!
QUIT DGQCNT
+18 ;
+19 ; Order through the user's combination source entries:
+20 KILL ^TMP("DG",$JOB,"DGQCPL")
+21 SET DGQSRC=0
+22 FOR
SET DGQSRC=$ORDER(^OR(100.24,DGQPTR,.01,DGQSRC))
IF 'ORQSRC
QUIT
Begin DoDot:1
+23 ;
+24 ; Get the actual source name based on the pointer entry value:
+25 SET DGQTXT=""
+26 SET DGQTXT=$GET(^OR(100.24,DGQPTR,.01,DGQSRC,0))
+27 IF '(DGQTXT="")
Begin DoDot:2
+28 ; Increment counter.
SET DGQCNT=DGQCNT+1
+29 ; Call tag to create complete string.
SET DGQTXT=$$COMBNM(DGQTXT)
+30 ;
+31 ; Write to ^TMP file for sorting:
+32 IF DGQTXT'=""
SET ^TMP("DG",$JOB,"DGQCPL",$PIECE(DGQTXT,U))=$PIECE(DGQTXT,U,2)
End DoDot:2
End DoDot:1
+33 ;
+34 ; Write data to the screen:
+35 ; Data to write?
IF DGQCNT
Begin DoDot:1
+36 ; Reset, re-use.
SET DGQTXT=""
+37 FOR
SET DGQTXT=$ORDER(^TMP("DG",$JOB,"DGQCPL",DGQTXT))
IF DGQTXT=""
QUIT
Begin DoDot:2
+38 WRITE !,$GET(^TMP("DG",$JOB,"DGQCPL",DGQTXT))
End DoDot:2
End DoDot:1
+39 ;
+40 ; Clean house.
KILL ^TMP("OR",$JOB,"DGQCPL")
+41 ;
+42 ; Return counter.
QUIT DGQCNT
+43 ;
COMBNM(DGQVAL) ; Returns name of "Combination" source entry, ^OR(100.24 file.
+1 ;
+2 ; Returned string is "X^Name^String" where X is letter of type,
+3 ; Name is name of entity, and String resembles examples below:
+4 ;
+5 ; W_1W^Ward: 1W SURGERY WEST
+6 ; P_JONES,WILMA MD^Provider: JONES,WILMA MD
+7 ; T_SURGERYLIST2^Team List: SURGERYLIST2
+8 ; (Etc.)
+9 ;
+10 ; Variables used:
+11 ;
+12 ; DGQFILE = File for retrieval of name.
+13 ; DGQPTR = Name string to return.
+14 ; DGQRTN = Value returned by this function.
+15 ; DGQVAL = Combo source entry pointer.
+16 ;
+17 NEW DGQPTR,DGQFILE,DGQRTN
+18 ; Error - punt.
IF '($DATA(DGQVAL))
QUIT DGQRTN
+19 ;
+20 ; Default init.
SET DGQRTN="No source found...."
+21 ; Get pointer.
SET DGQPTR=$PIECE(DGQVAL,";")
+22 ; Get file.
SET DGQFILE="^"_$PIECE(DGQVAL,";",2)
+23 ;
+24 ; Wards.
IF DGQFILE="^DIC(42,"
Begin DoDot:1
+25 SET DGQRTN=$GET(^DIC(42,DGQPTR,0))
+26 IF $DATA(DGQRTN)
SET DGQRTN="W"_"_"_$PIECE(DGQRTN,U)_U_"Ward: "_$PIECE(DGQRTN,U)_" "_$PIECE(DGQRTN,U,2)
End DoDot:1
QUIT DGQRTN
+27 ;
+28 ; Providers.
IF DGQFILE="^VA(200,"
Begin DoDot:1
+29 SET DGQRTN=$GET(^VA(200,DGQPTR,0))
+30 IF $DATA(DGQRTN)
SET DGQRTN="P"_"_"_$PIECE(DGQRTN,U)_U_"Provider: "_$PIECE(DGQRTN,U)
End DoDot:1
QUIT DGQRTN
+31 ;
+32 ; Specialties.
IF DGQFILE="^DIC(45.7,"
Begin DoDot:1
+33 SET DGQRTN=$GET(^DIC(45.7,DGQPTR,0))
+34 IF $DATA(DGQRTN)
SET DGQRTN="S"_"_"_$PIECE(DGQRTN,U)_U_"Specialty: "_$PIECE(DGQRTN,U)
End DoDot:1
QUIT DGQRTN
+35 ;
+36 ; Team Lists.
IF DGQFILE="^OR(100.21,"
Begin DoDot:1
+37 SET DGQRTN=$GET(^OR(100.21,DGQPTR,0))
+38 IF $DATA(DGQRTN)
SET DGQRTN="T"_"_"_$PIECE(DGQRTN,U)_U_"Team List: "_$PIECE(DGQRTN,U)
End DoDot:1
QUIT DGQRTN
+39 ;
+40 ; Clinics.
IF DGQFILE="^SC("
Begin DoDot:1
+41 SET DGQRTN=$GET(^SC(DGQPTR,0))
+42 IF $DATA(DGQRTN)
SET DGQRTN="C"_"_"_$PIECE(DGQRTN,U)_U_"Clinic: "_$PIECE(DGQRTN,U)
End DoDot:1
QUIT DGQRTN
+43 ;
+44 ; Return value (null will be returned if nothing matched):
+45 QUIT DGQRTN
+46 ;
PTSCOMBO(DGQTYP,DGQPTR) ; Write ^TMP("DG",$J,"PATIENTS","B") patient entries.
+1 ;
+2 ; Called from COMBPTS^DGQPTQ6.
+3 ; (DGQCNT,DGQPDAT,DGQPIEN,DGQPNM,SORT new'd in calling code.)
+4 ; (Array DGY new'd in calling routine DGQPTQ2.)
+5 ;
+6 ; Variables used:
+7 ;
+8 ; DGQDOB = Patient DOB.
+9 ; DGQDONE = Flag for end of patient records.
+10 ; DGQIDT = Clinic app't date stored in internal format.
+11 ; DGQMORE = Room/bed or appointment information.
+12 ; DGQPTR = PASSED: Pointer from subfile entry, combination file.
+13 ; DGQSNM = Name of source from subfile entry pointer.
+14 ; DGQSNM4 = First four letters of name of source.
+15 ; DGQSSN = Patient SSN suffix.
+16 ; DGQTYP = PASSED: Holds source type:
+17 ;
+18 ; W = Ward
+19 ; P = Provider
+20 ; S = Specialty
+21 ; T = Team List
+22 ; C = Clinic
+23 ;
+24 NEW DGQDOB,DGQDONE,DGQIDT,DGQMORE,DGQSNM,DGQSNM4,DGQSSN
+25 ;
+26 ; Initialize variables:
+27 SET DGQDONE=0
+28 SET DGQCNT=1
+29 ;
+30 ; Get name data for source:
+31 ; Default setting.
SET DGQSNM4=""
+32 ; Wards.
IF DGQTYP="W"
SET DGQSNM4=$GET(^DIC(42,DGQPTR,0))
+33 ; Providers.
IF DGQTYP="P"
SET DGQSNM4=$GET(^VA(200,DGQPTR,0))
+34 ; Specialties.
IF DGQTYP="S"
SET DGQSNM4=$GET(^DIC(45.7,DGQPTR,0))
+35 ; Team Lists.
IF DGQTYP="T"
SET DGQSNM4=$GET(^OR(100.21,DGQPTR,0))
+36 ; Clinics.
IF DGQTYP="C"
SET DGQSNM4=$GET(^SC(DGQPTR,0))
+37 ;
+38 ; Assure use of first 4 letters of name:
+39 ; Add 4 for safety.
SET DGQSNM4=$PIECE(DGQSNM4,U)_" "
+40 ; Get first 4 only.
SET DGQSNM4=$EXTRACT(DGQSNM4,1,4)
+41 ;
+42 ; Add label prefix to source name:
+43 ; Default setting.
SET DGQSNM=""
+44 ; Get correct name.
SET DGQSNM=$SELECT(DGQTYP="W":"Wd ",DGQTYP="P":"Pr ",DGQTYP="S":"Sp ",DGQTYP="T":"Tm ",DGQTYP="C":"Cl ",1:" ")
+45 ; Prepend label.
SET DGQSNM=DGQSNM_DGQSNM4
+46 ;
+47 ; Order thru DGY array created by calls in calling routine:
+48 ; Initialize.
SET DGQPDAT=""
+49 FOR
SET DGQPDAT=$GET(DGY(DGQCNT))
IF ((DGQPDAT="")!(DGQDONE))
QUIT
Begin DoDot:1
+50 ;
+51 ; Clear variables each time:
+52 SET (DGQPIEN,DGQPNM,DGQSSN,DGQDOB,DGQIDT,DGQMORE)=""
+53 ;
+54 ; Get patient IEN.
SET DGQPIEN=$PIECE(DGQPDAT,U)
+55 ; Punt if no IEN.
IF DGQPIEN=""
SET DGQDONE=1
QUIT
+56 ; Get patient name.
SET DGQPNM=$PIECE(DGQPDAT,U,2)
+57 ;
+58 ; Get patient SSN suffix:
+59 SET DGQSSN=$$ID($GET(DGQPIEN))
+60 ;
+61 ; Get patient DOB:
+62 SET DGQDOB=$$FMTE^XLFDT($PIECE($GET(^DPT(DGQPIEN,0)),U,3))
+63 ;
+64 ; Get patient room/bed information where data exists:
+65 SET DGQMORE=$PIECE($GET(^DPT(DGQPIEN,.101)),U)
+66 ;
+67 ; Assure at least 4 letters for any existing room/bed data:
+68 ; Any data now?
IF DGQMORE'=""
Begin DoDot:2
+69 ; Less than 4 now?
IF $LENGTH(DGQMORE)<4
Begin DoDot:3
+70 ; Add 3 for safety.
SET DGQMORE=DGQMORE_" "
+71 ; Get first 4 only.
SET DGQMORE=$EXTRACT(DGQMORE,1,4)
End DoDot:3
End DoDot:2
+72 ;
+73 ; Get clinic appointment information, if applicable:
+74 IF DGQTYP="C"
Begin DoDot:2
+75 ; Reset, re-use.
SET DGQMORE=""
+76 ; App't data.
SET DGQMORE=$PIECE(DGQPDAT,U,4)
+77 ; Internal format.
SET DGQIDT=DGQMORE
+78 SET $PIECE(DGQMORE,".",2)=$EXTRACT($PIECE(DGQMORE,".",2)_"000",1,4)
+79 ; Format app't.
SET DGQMORE=$$FMTE^XLFDT($PIECE(DGQMORE,U))
End DoDot:2
+80 ;
+81 ; Write a sorted entry in ^TMP("DG",$J,"PATIENTS","B"):
+82 ; (Node's data:)
+83 ; (DFN^PtName^SSN^DOB^SourceName^App't/Room/Bed^SourceIEN)
+84 IF DGQPIEN'=""
Begin DoDot:2
+85 ;
+86 ; Write using source name first if sorted by "S" (source) -or-
+87 ; if "P" (app't) sort and not a clinic:
+88 IF ((SORT="S")!((SORT="P")&(DGQTYP'="C")))
Begin DoDot:3
+89 SET ^TMP("DG",$JOB,"PATIENTS","B",DGQSNM_" "_DGQPNM_" "_DGQPIEN_" "_DGQIDT)=DGQPIEN_U_DGQPNM_U_DGQSSN_U_DGQDOB_U_DGQSNM_U_DGQMORE_U_DGQPTR_U_DGQIDT
End DoDot:3
QUIT
+90 ;
+91 ; Use source source+app't first if "P" (app't) sort, and a clinic:
+92 IF ((DGQTYP="C")&(SORT="P"))
Begin DoDot:3
+93 SET ^TMP("DG",$JOB,"PATIENTS","B",DGQSNM_" "_DGQIDT_" "_DGQPNM_" "_DGQPIEN)=DGQPIEN_U_DGQPNM_U_DGQSSN_U_DGQDOB_U_DGQSNM_U_DGQMORE_U_DGQPTR_U_DGQIDT
End DoDot:3
QUIT
+94 ;
+95 ; If not by source or source/app't, default to alpha ("A") sort:
+96 SET ^TMP("DG",$JOB,"PATIENTS","B",DGQPNM_" "_DGQPIEN_" "_DGQSNM_" "_DGQIDT)=DGQPIEN_U_DGQPNM_U_DGQSSN_U_DGQDOB_U_DGQSNM_U_DGQMORE_U_DGQPTR_U_DGQIDT
End DoDot:2
+97 ;
+98 ; Increment counter.
SET DGQCNT=DGQCNT+1
End DoDot:1
+99 ;
+100 QUIT
+101 ;
ID(DGQPIEN) ; Return short ID for patient ID.
+1 ; (Copied from DGQPT routine and modified.)
+2 ;
+3 NEW ID
+4 ;
+5 ; Gets short ID.
SET ID=$PIECE($GET(^DPT(DGQPIEN,.36)),U,4)
+6 ; - or -
IF '$LENGTH(ID)
Begin DoDot:1
+7 ; Last 4 of SSN
SET ID=$EXTRACT($PIECE($GET(^DPT(DGQPIEN,0)),U,9),6,9)
End DoDot:1
+8 ;
+9 QUIT "("_$EXTRACT(DGQPNM)_ID_")"
+10 ;
