Routine: DGQPTQ5

DGQPTQ5 ; SLC/PKS - Functions for Patient Selection Lists. ; 6/5/01 12:37pm

 ;;5.3;Registration;**447,1015**;Aug 13, 1993;Build 21

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.

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      ;

DGQPTQ5.m