ORQPTQ5 ; SLC/PKS - Functions for Patient Selection Lists. [4/23/04 4:49pm];05/27/14 18:25
;;3.0;ORDER ENTRY/RESULTS REPORTING;**82,85,187,190,320,377**;Dec 17, 1997;Build 582
;
; External Reference
; DBIA #2936 File 404.51 Read w/ FileMan
Q
;
COMBDISP(ORQDUZ,ORQPTR) ; Display user's "Combination" pt selection sources.
;
; Variables used:
;
; ORQCNT = Counter for number of entries displayed.
; ORQDUZ = DUZ of user involved.
; ORQPTR = IEN for user's OE/RR PT SEL COMBO file entries.
; ORQSRC = $O command values from combo entries, file ^OR(100.24,.
; ORQTXT = Text name string for combo entry pointers.
;
N ORQCNT,ORQSRC,ORQTXT
;
; Check passed variables, punt on errors:
S ORQCNT=0
I '($D(ORQDUZ)) W !,"No user DUZ passed.",! Q ORQCNT
I '($D(ORQPTR)) W !,"No combination pointer passed.",! Q ORQCNT
I ORQDUZ="" W !,"No user DUZ passed.",! Q ORQCNT
I ORQPTR="" W !,"No combination pointer passed.",! Q ORQCNT
;
; Order through the user's combination source entries:
K ^TMP("OR",$J,"ORQCPL")
S ORQSRC=0
F S ORQSRC=$O(^OR(100.24,ORQPTR,.01,ORQSRC)) Q:'ORQSRC D
.;
.; Get the actual source name based on the pointer entry value:
.S ORQTXT=""
.S ORQTXT=$G(^OR(100.24,ORQPTR,.01,ORQSRC,0))
.I '(ORQTXT="") D
..S ORQCNT=ORQCNT+1 ; Increment counter.
..S ORQTXT=$$COMBNM(ORQTXT) ; Call tag to create complete string.
..;
..; Write to ^TMP file for sorting:
..I ORQTXT'="" S ^TMP("OR",$J,"ORQCPL",$P(ORQTXT,U))=$P(ORQTXT,U,2)
;
; Write data to the screen:
I ORQCNT D ; Data to write?
.S ORQTXT="" ; Reset, re-use.
.F S ORQTXT=$O(^TMP("OR",$J,"ORQCPL",ORQTXT)) Q:ORQTXT="" D
..W !,$G(^TMP("OR",$J,"ORQCPL",ORQTXT))
;
K ^TMP("OR",$J,"ORQCPL") ; Clean house.
;
Q ORQCNT ; Return counter.
;
COMBNM(ORQVAL) ; 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:
;
; ORQFILE = File for retrieval of name.
; ORQPTR = Name string to return.
; ORQRTN = Value returned by this function.
; ORQVAL = Combo source entry pointer.
;
N ORQPTR,ORQFILE,ORQRTN
I '($D(ORQVAL)) Q ORQRTN ; Error - punt.
;
S ORQRTN="No source found...." ; Default init.
S ORQPTR=$P(ORQVAL,";") ; Get pointer.
S ORQFILE="^"_$P(ORQVAL,";",2) ; Get file.
;
I ORQFILE="^DIC(42," D Q ORQRTN ; Wards.
.S ORQRTN=$G(^DIC(42,ORQPTR,0))
.I $D(ORQRTN) S ORQRTN="W"_"_"_$P(ORQRTN,U)_U_"Ward: "_$P(ORQRTN,U)_" "_$P(ORQRTN,U,2)
;
I ORQFILE="^VA(200," D Q ORQRTN ; Providers.
.S ORQRTN=$G(^VA(200,ORQPTR,0))
.I $D(ORQRTN) S ORQRTN="P"_"_"_$P(ORQRTN,U)_U_"Provider: "_$P(ORQRTN,U)
;
I ORQFILE="^DIC(45.7," D Q ORQRTN ; Specialties.
.S ORQRTN=$G(^DIC(45.7,ORQPTR,0))
.I $D(ORQRTN) S ORQRTN="S"_"_"_$P(ORQRTN,U)_U_"Specialty: "_$P(ORQRTN,U)
;
I ORQFILE="^OR(100.21," D Q ORQRTN ; Team Lists.
.S ORQRTN=$G(^OR(100.21,ORQPTR,0))
.I $D(ORQRTN) S ORQRTN="T"_"_"_$P(ORQRTN,U)_U_"Team List: "_$P(ORQRTN,U)
;
I ORQFILE="^SC(" D Q ORQRTN ; Clinics.
.S ORQRTN=$G(^SC(ORQPTR,0))
.I $D(ORQRTN) S ORQRTN="C"_"_"_$P(ORQRTN,U)_U_"Clinic: "_$P(ORQRTN,U)
;
; Return value (null will be returned if nothing matched):
Q ORQRTN
;
PTSCOMBO(ORQTYP,ORQPTR,APPTEND) ; Write ^TMP("OR",$J,"PATIENTS","B") patient entries.
; TDP 5/21/2014 - Added PCMM Team (E) code
; Called from COMBPTS^ORQPTQ6.
; (ORQCNT,ORQPDAT,ORQPIEN,ORQPNM,ORQPSTAT,SORT,ORQLM,ORY,ORBDATE,OREDATE new'd in calling tag.)
;
; Variables used:
;
; ORQDOB = Patient DOB.
; ORQDONE = Flag for end of patient records.
; ORQIDT = Clinic app't date stored in internal format.
; ORQMORE = Room/bed or appointment information.
; ORQPTR = PASSED: Pointer from subfile entry, combination file.
; ORQSNM = Name of source from subfile entry pointer.
; ORQSNM4 = First four letters of name of source.
; ORQSSN = Patient SSN suffix.
; ORQTYP = PASSED: Holds source type:
;
; W = Ward
; P = Provider
; S = Specialty
; T = Team List
; C = Clinic
; E = PCMM Team List
;
N ORQDOB,ORQDONE,ORQIDT,ORQMORE,ORQSNM,ORQSNM4,ORQSSN,OLDAPPTEND,DATEDIF
;
; Initialize variables:
S ORQDONE=0
S ORQCNT=0
;
; Get name data for source:
S ORQSNM4="" ; Default setting.
I ORQTYP="W" S ORQSNM4=$G(^DIC(42,ORQPTR,0)) ; Wards.
I ORQTYP="P" S ORQSNM4=$G(^VA(200,ORQPTR,0)) ; Providers.
I ORQTYP="S" S ORQSNM4=$G(^DIC(45.7,ORQPTR,0)) ; Specialties.
I ORQTYP="T" S ORQSNM4=$G(^OR(100.21,ORQPTR,0)) ; Team Lists.
I ORQTYP="E" D ; PCMM Team Lists.
.N DIC,DLAYGO,X,Y
.S DIC="^SCTM(404.51,"
.S DIC(0)=""
.S X="`"_ORQPTR
.D ^DIC
.S ORQSNM4=$P(Y,U,2)
I ORQTYP="C" D ; Clinics.
.S ORQSNM4=$G(^SC(ORQPTR,0))
.I ($O(ORY(""),-1)'<200),'ORQLM,(ORBDATE'=OREDATE) D
..I '$G(APPTEND) Q
..S ^TMP("OR",$J,"PATIENTS",-1)=" ^ *** UNABLE TO SHOW ALL APPOINTMENTS ***^ ^ ^ "
..S APPTEND=$$FMTH^XLFDT(APPTEND,1)-1 ;set to MUMPS' $H format
..S OLDAPPTEND=$S($D(^TMP("OR",$J,"PATIENTS",-2)):$O(^(-2,"")),1:9999999)
..I APPTEND<OLDAPPTEND D
...K ^TMP("OR",$J,"PATIENTS",-2)
...S DATEDIF=$S(APPTEND=+$H:"T",APPTEND<$H:"T-"_($H-APPTEND),APPTEND>$H:"T+"_(APPTEND-$H))
...S ^TMP("OR",$J,"PATIENTS",-2,APPTEND)=" ^"_$C(160)_" Reduce the date range by changing the stop date of the Patient Selection Defaults to "_DATEDIF_".^ ^ ^ "
..S ^TMP("OR",$J,"PATIENTS",-3)=" ^"_$C(160)_$C(160)_$C(160)_$C(160)_" ^ ^ ^ " ;add blank line
..S ^TMP("OR",$J,"PATIENTS",$O(^TMP("OR",$J,"PATIENTS",""))-1)=" ^ Showing only the first 200 appointments from "_$P(ORQSNM4,U)_"^ ^ ^ "
;
; Assure use of first 4 letters of name:
S ORQSNM4=$P(ORQSNM4,U)_" " ; Add 4 for safety.
S ORQSNM4=$E(ORQSNM4,1,4) ; Get first 4 only.
;
; Add label prefix to source name:
S ORQSNM="" ; Default setting.
S ORQSNM=$S(ORQTYP="W":"Wd ",ORQTYP="P":"Pr ",ORQTYP="S":"Sp ",ORQTYP="T":"Tm ",ORQTYP="C":"Cl ",ORQTYP="E":"Pm ",1:" ") ; Get correct name.
S ORQSNM=ORQSNM_ORQSNM4 ; Prepend label.
;
; Order thru ORY array created by calls in calling routine:
S ORQPDAT="" ; Initialize.
F S ORQCNT=$O(ORY(ORQCNT)) Q:'ORQCNT S ORQPDAT=$G(ORY(ORQCNT)) Q:((ORQPDAT="")!(ORQDONE)) D
.;
.; Clear variables each time:
.S (ORQPIEN,ORQPNM,ORQSSN,ORQDOB,ORQIDT,ORQMORE,ORQPSTAT)=""
.;
.S ORQPIEN=$P(ORQPDAT,U) ; Get patient IEN.
.I ORQPIEN="" D Q ; Punt if no IEN.
..I ORQPDAT="^No appointments." S ORQDONE=1 Q
..I ORQTYP="C" D
...S ^TMP("OR",$J,"PATIENTS","B",ORQSNM_ORQPDAT)=ORQPDAT
..I ORQTYP'="C" S ORQDONE=1
.S ORQPNM=$P(ORQPDAT,U,2) ; Get patient name.
.;
.; Get patient SSN suffix:
.S ORQSSN=$$ID($G(ORQPIEN))
.;
.; Get patient DOB:
.S ORQDOB=$$FMTE^XLFDT($P($G(^DPT(ORQPIEN,0)),U,3))
.;
.; Get patient room/bed information where data exists:
.S ORQMORE=$P($G(^DPT(ORQPIEN,.101)),U)
.;
.; Assure at least 4 letters for any existing room/bed data:
.I ORQMORE'="" D ; Any data now?
..I $L(ORQMORE)<4 D ; Less than 4 now?
...S ORQMORE=ORQMORE_" " ; Add 3 for safety.
...S ORQMORE=$E(ORQMORE,1,4) ; Get first 4 only.
.;
.; Get clinic appointment information, if applicable:
.I ORQTYP="C" D
..S ORQMORE="" ; Reset, re-use.
..S ORQMORE=$P(ORQPDAT,U,4) ; App't data.
..S ORQIDT=ORQMORE ; Internal format.
..S $P(ORQMORE,".",2)=$E($P(ORQMORE,".",2)_"000",1,4)
..S ORQMORE=$$FMTE^XLFDT($P(ORQMORE,U)) ; Format app't.
..S ORQPSTAT=$P(ORQPDAT,U,9) ; Ipt/Opt status.
.;
.; Write a sorted entry in ^TMP("OR",$J,"PATIENTS","B"):
.; (Node's data:)
.; (DFN^PtName^SSN^DOB^SourceName^App't/Room/Bed^SourceIEN^IOStat)
.I ORQPIEN'="" 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")&(ORQTYP'="C"))) D Q
...S ^TMP("OR",$J,"PATIENTS","B",ORQSNM_" "_ORQPNM_" "_ORQPIEN_" "_ORQIDT)=ORQPIEN_U_ORQPNM_U_ORQSSN_U_ORQDOB_U_ORQSNM_U_ORQMORE_U_ORQPTR_U_ORQIDT_U_ORQPSTAT
..;
..; Use source source+app't first if "P" (app't) sort, and a clinic:
..I ((ORQTYP="C")&(SORT="P")) D Q
...S ^TMP("OR",$J,"PATIENTS","B",ORQSNM_" "_ORQIDT_" "_ORQPNM_" "_ORQPIEN)=ORQPIEN_U_ORQPNM_U_ORQSSN_U_ORQDOB_U_ORQSNM_U_ORQMORE_U_ORQPTR_U_ORQIDT_U_ORQPSTAT
..;
..; If not by source or source/app't, default to alpha ("A") sort:
..S ^TMP("OR",$J,"PATIENTS","B",ORQPNM_" "_ORQPIEN_" "_ORQSNM_" "_ORQIDT)=ORQPIEN_U_ORQPNM_U_ORQSSN_U_ORQDOB_U_ORQSNM_U_ORQMORE_U_ORQPTR_U_ORQIDT_U_ORQPSTAT
;
Q
;
ID(ORQPIEN) ; Return short ID for patient ID.
; (Copied from ORQPT routine and modified.)
;
N ID
;
S ID=$P($G(^DPT(ORQPIEN,.36)),U,4) ; Gets short ID.
I '$L(ID) D ; - or -
.S ID=$E($P($G(^DPT(ORQPIEN,0)),U,9),6,9) ; Last 4 of SSN
;
Q "("_$E(ORQPNM)_ID_")"
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQPTQ5 10064 printed Sep 23, 2025@20:09:49 Page 2
ORQPTQ5 ; SLC/PKS - Functions for Patient Selection Lists. [4/23/04 4:49pm];05/27/14 18:25
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**82,85,187,190,320,377**;Dec 17, 1997;Build 582
+2 ;
+3 ; External Reference
+4 ; DBIA #2936 File 404.51 Read w/ FileMan
+5 QUIT
+6 ;
COMBDISP(ORQDUZ,ORQPTR) ; Display user's "Combination" pt selection sources.
+1 ;
+2 ; Variables used:
+3 ;
+4 ; ORQCNT = Counter for number of entries displayed.
+5 ; ORQDUZ = DUZ of user involved.
+6 ; ORQPTR = IEN for user's OE/RR PT SEL COMBO file entries.
+7 ; ORQSRC = $O command values from combo entries, file ^OR(100.24,.
+8 ; ORQTXT = Text name string for combo entry pointers.
+9 ;
+10 NEW ORQCNT,ORQSRC,ORQTXT
+11 ;
+12 ; Check passed variables, punt on errors:
+13 SET ORQCNT=0
+14 IF '($DATA(ORQDUZ))
WRITE !,"No user DUZ passed.",!
QUIT ORQCNT
+15 IF '($DATA(ORQPTR))
WRITE !,"No combination pointer passed.",!
QUIT ORQCNT
+16 IF ORQDUZ=""
WRITE !,"No user DUZ passed.",!
QUIT ORQCNT
+17 IF ORQPTR=""
WRITE !,"No combination pointer passed.",!
QUIT ORQCNT
+18 ;
+19 ; Order through the user's combination source entries:
+20 KILL ^TMP("OR",$JOB,"ORQCPL")
+21 SET ORQSRC=0
+22 FOR
SET ORQSRC=$ORDER(^OR(100.24,ORQPTR,.01,ORQSRC))
if 'ORQSRC
QUIT
Begin DoDot:1
+23 ;
+24 ; Get the actual source name based on the pointer entry value:
+25 SET ORQTXT=""
+26 SET ORQTXT=$GET(^OR(100.24,ORQPTR,.01,ORQSRC,0))
+27 IF '(ORQTXT="")
Begin DoDot:2
+28 ; Increment counter.
SET ORQCNT=ORQCNT+1
+29 ; Call tag to create complete string.
SET ORQTXT=$$COMBNM(ORQTXT)
+30 ;
+31 ; Write to ^TMP file for sorting:
+32 IF ORQTXT'=""
SET ^TMP("OR",$JOB,"ORQCPL",$PIECE(ORQTXT,U))=$PIECE(ORQTXT,U,2)
End DoDot:2
End DoDot:1
+33 ;
+34 ; Write data to the screen:
+35 ; Data to write?
IF ORQCNT
Begin DoDot:1
+36 ; Reset, re-use.
SET ORQTXT=""
+37 FOR
SET ORQTXT=$ORDER(^TMP("OR",$JOB,"ORQCPL",ORQTXT))
if ORQTXT=""
QUIT
Begin DoDot:2
+38 WRITE !,$GET(^TMP("OR",$JOB,"ORQCPL",ORQTXT))
End DoDot:2
End DoDot:1
+39 ;
+40 ; Clean house.
KILL ^TMP("OR",$JOB,"ORQCPL")
+41 ;
+42 ; Return counter.
QUIT ORQCNT
+43 ;
COMBNM(ORQVAL) ; 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 ; ORQFILE = File for retrieval of name.
+13 ; ORQPTR = Name string to return.
+14 ; ORQRTN = Value returned by this function.
+15 ; ORQVAL = Combo source entry pointer.
+16 ;
+17 NEW ORQPTR,ORQFILE,ORQRTN
+18 ; Error - punt.
IF '($DATA(ORQVAL))
QUIT ORQRTN
+19 ;
+20 ; Default init.
SET ORQRTN="No source found...."
+21 ; Get pointer.
SET ORQPTR=$PIECE(ORQVAL,";")
+22 ; Get file.
SET ORQFILE="^"_$PIECE(ORQVAL,";",2)
+23 ;
+24 ; Wards.
IF ORQFILE="^DIC(42,"
Begin DoDot:1
+25 SET ORQRTN=$GET(^DIC(42,ORQPTR,0))
+26 IF $DATA(ORQRTN)
SET ORQRTN="W"_"_"_$PIECE(ORQRTN,U)_U_"Ward: "_$PIECE(ORQRTN,U)_" "_$PIECE(ORQRTN,U,2)
End DoDot:1
QUIT ORQRTN
+27 ;
+28 ; Providers.
IF ORQFILE="^VA(200,"
Begin DoDot:1
+29 SET ORQRTN=$GET(^VA(200,ORQPTR,0))
+30 IF $DATA(ORQRTN)
SET ORQRTN="P"_"_"_$PIECE(ORQRTN,U)_U_"Provider: "_$PIECE(ORQRTN,U)
End DoDot:1
QUIT ORQRTN
+31 ;
+32 ; Specialties.
IF ORQFILE="^DIC(45.7,"
Begin DoDot:1
+33 SET ORQRTN=$GET(^DIC(45.7,ORQPTR,0))
+34 IF $DATA(ORQRTN)
SET ORQRTN="S"_"_"_$PIECE(ORQRTN,U)_U_"Specialty: "_$PIECE(ORQRTN,U)
End DoDot:1
QUIT ORQRTN
+35 ;
+36 ; Team Lists.
IF ORQFILE="^OR(100.21,"
Begin DoDot:1
+37 SET ORQRTN=$GET(^OR(100.21,ORQPTR,0))
+38 IF $DATA(ORQRTN)
SET ORQRTN="T"_"_"_$PIECE(ORQRTN,U)_U_"Team List: "_$PIECE(ORQRTN,U)
End DoDot:1
QUIT ORQRTN
+39 ;
+40 ; Clinics.
IF ORQFILE="^SC("
Begin DoDot:1
+41 SET ORQRTN=$GET(^SC(ORQPTR,0))
+42 IF $DATA(ORQRTN)
SET ORQRTN="C"_"_"_$PIECE(ORQRTN,U)_U_"Clinic: "_$PIECE(ORQRTN,U)
End DoDot:1
QUIT ORQRTN
+43 ;
+44 ; Return value (null will be returned if nothing matched):
+45 QUIT ORQRTN
+46 ;
PTSCOMBO(ORQTYP,ORQPTR,APPTEND) ; Write ^TMP("OR",$J,"PATIENTS","B") patient entries.
+1 ; TDP 5/21/2014 - Added PCMM Team (E) code
+2 ; Called from COMBPTS^ORQPTQ6.
+3 ; (ORQCNT,ORQPDAT,ORQPIEN,ORQPNM,ORQPSTAT,SORT,ORQLM,ORY,ORBDATE,OREDATE new'd in calling tag.)
+4 ;
+5 ; Variables used:
+6 ;
+7 ; ORQDOB = Patient DOB.
+8 ; ORQDONE = Flag for end of patient records.
+9 ; ORQIDT = Clinic app't date stored in internal format.
+10 ; ORQMORE = Room/bed or appointment information.
+11 ; ORQPTR = PASSED: Pointer from subfile entry, combination file.
+12 ; ORQSNM = Name of source from subfile entry pointer.
+13 ; ORQSNM4 = First four letters of name of source.
+14 ; ORQSSN = Patient SSN suffix.
+15 ; ORQTYP = PASSED: Holds source type:
+16 ;
+17 ; W = Ward
+18 ; P = Provider
+19 ; S = Specialty
+20 ; T = Team List
+21 ; C = Clinic
+22 ; E = PCMM Team List
+23 ;
+24 NEW ORQDOB,ORQDONE,ORQIDT,ORQMORE,ORQSNM,ORQSNM4,ORQSSN,OLDAPPTEND,DATEDIF
+25 ;
+26 ; Initialize variables:
+27 SET ORQDONE=0
+28 SET ORQCNT=0
+29 ;
+30 ; Get name data for source:
+31 ; Default setting.
SET ORQSNM4=""
+32 ; Wards.
IF ORQTYP="W"
SET ORQSNM4=$GET(^DIC(42,ORQPTR,0))
+33 ; Providers.
IF ORQTYP="P"
SET ORQSNM4=$GET(^VA(200,ORQPTR,0))
+34 ; Specialties.
IF ORQTYP="S"
SET ORQSNM4=$GET(^DIC(45.7,ORQPTR,0))
+35 ; Team Lists.
IF ORQTYP="T"
SET ORQSNM4=$GET(^OR(100.21,ORQPTR,0))
+36 ; PCMM Team Lists.
IF ORQTYP="E"
Begin DoDot:1
+37 NEW DIC,DLAYGO,X,Y
+38 SET DIC="^SCTM(404.51,"
+39 SET DIC(0)=""
+40 SET X="`"_ORQPTR
+41 DO ^DIC
+42 SET ORQSNM4=$PIECE(Y,U,2)
End DoDot:1
+43 ; Clinics.
IF ORQTYP="C"
Begin DoDot:1
+44 SET ORQSNM4=$GET(^SC(ORQPTR,0))
+45 IF ($ORDER(ORY(""),-1)'<200)
IF 'ORQLM
IF (ORBDATE'=OREDATE)
Begin DoDot:2
+46 IF '$GET(APPTEND)
QUIT
+47 SET ^TMP("OR",$JOB,"PATIENTS",-1)=" ^ *** UNABLE TO SHOW ALL APPOINTMENTS ***^ ^ ^ "
+48 ;set to MUMPS' $H format
SET APPTEND=$$FMTH^XLFDT(APPTEND,1)-1
+49 SET OLDAPPTEND=$SELECT($DATA(^TMP("OR",$JOB,"PATIENTS",-2)):$ORDER(^(-2,"")),1:9999999)
+50 IF APPTEND<OLDAPPTEND
Begin DoDot:3
+51 KILL ^TMP("OR",$JOB,"PATIENTS",-2)
+52 SET DATEDIF=$SELECT(APPTEND=+$HOROLOG:"T",APPTEND<$HOROLOG:"T-"_($HOROLOG-APPTEND),APPTEND>$HOROLOG:"T+"_(APPTEND-$HOROLOG))
+53 SET ^TMP("OR",$JOB,"PATIENTS",-2,APPTEND)=" ^"_$CHAR(160)_" Reduce the date range by changing the stop date of the Patient Selection Defaults to "_DATEDIF_".^ ^ ^ "
End DoDot:3
+54 ;add blank line
SET ^TMP("OR",$JOB,"PATIENTS",-3)=" ^"_$CHAR(160)_$CHAR(160)_$CHAR(160)_$CHAR(160)_" ^ ^ ^ "
+55 SET ^TMP("OR",$JOB,"PATIENTS",$ORDER(^TMP("OR",$JOB,"PATIENTS",""))-1)=" ^ Showing only the first 200 appointments from "_$PIECE(ORQSNM4,U)_"^ ^ ^ "
End DoDot:2
End DoDot:1
+56 ;
+57 ; Assure use of first 4 letters of name:
+58 ; Add 4 for safety.
SET ORQSNM4=$PIECE(ORQSNM4,U)_" "
+59 ; Get first 4 only.
SET ORQSNM4=$EXTRACT(ORQSNM4,1,4)
+60 ;
+61 ; Add label prefix to source name:
+62 ; Default setting.
SET ORQSNM=""
+63 ; Get correct name.
SET ORQSNM=$SELECT(ORQTYP="W":"Wd ",ORQTYP="P":"Pr ",ORQTYP="S":"Sp ",ORQTYP="T":"Tm ",ORQTYP="C":"Cl ",ORQTYP="E":"Pm ",1:" ")
+64 ; Prepend label.
SET ORQSNM=ORQSNM_ORQSNM4
+65 ;
+66 ; Order thru ORY array created by calls in calling routine:
+67 ; Initialize.
SET ORQPDAT=""
+68 FOR
SET ORQCNT=$ORDER(ORY(ORQCNT))
if 'ORQCNT
QUIT
SET ORQPDAT=$GET(ORY(ORQCNT))
if ((ORQPDAT="")!(ORQDONE))
QUIT
Begin DoDot:1
+69 ;
+70 ; Clear variables each time:
+71 SET (ORQPIEN,ORQPNM,ORQSSN,ORQDOB,ORQIDT,ORQMORE,ORQPSTAT)=""
+72 ;
+73 ; Get patient IEN.
SET ORQPIEN=$PIECE(ORQPDAT,U)
+74 ; Punt if no IEN.
IF ORQPIEN=""
Begin DoDot:2
+75 IF ORQPDAT="^No appointments."
SET ORQDONE=1
QUIT
+76 IF ORQTYP="C"
Begin DoDot:3
+77 SET ^TMP("OR",$JOB,"PATIENTS","B",ORQSNM_ORQPDAT)=ORQPDAT
End DoDot:3
+78 IF ORQTYP'="C"
SET ORQDONE=1
End DoDot:2
QUIT
+79 ; Get patient name.
SET ORQPNM=$PIECE(ORQPDAT,U,2)
+80 ;
+81 ; Get patient SSN suffix:
+82 SET ORQSSN=$$ID($GET(ORQPIEN))
+83 ;
+84 ; Get patient DOB:
+85 SET ORQDOB=$$FMTE^XLFDT($PIECE($GET(^DPT(ORQPIEN,0)),U,3))
+86 ;
+87 ; Get patient room/bed information where data exists:
+88 SET ORQMORE=$PIECE($GET(^DPT(ORQPIEN,.101)),U)
+89 ;
+90 ; Assure at least 4 letters for any existing room/bed data:
+91 ; Any data now?
IF ORQMORE'=""
Begin DoDot:2
+92 ; Less than 4 now?
IF $LENGTH(ORQMORE)<4
Begin DoDot:3
+93 ; Add 3 for safety.
SET ORQMORE=ORQMORE_" "
+94 ; Get first 4 only.
SET ORQMORE=$EXTRACT(ORQMORE,1,4)
End DoDot:3
End DoDot:2
+95 ;
+96 ; Get clinic appointment information, if applicable:
+97 IF ORQTYP="C"
Begin DoDot:2
+98 ; Reset, re-use.
SET ORQMORE=""
+99 ; App't data.
SET ORQMORE=$PIECE(ORQPDAT,U,4)
+100 ; Internal format.
SET ORQIDT=ORQMORE
+101 SET $PIECE(ORQMORE,".",2)=$EXTRACT($PIECE(ORQMORE,".",2)_"000",1,4)
+102 ; Format app't.
SET ORQMORE=$$FMTE^XLFDT($PIECE(ORQMORE,U))
+103 ; Ipt/Opt status.
SET ORQPSTAT=$PIECE(ORQPDAT,U,9)
End DoDot:2
+104 ;
+105 ; Write a sorted entry in ^TMP("OR",$J,"PATIENTS","B"):
+106 ; (Node's data:)
+107 ; (DFN^PtName^SSN^DOB^SourceName^App't/Room/Bed^SourceIEN^IOStat)
+108 IF ORQPIEN'=""
Begin DoDot:2
+109 ;
+110 ; Write using source name first if sorted by "S" (source) -or-
+111 ; if "P" (app't) sort and not a clinic:
+112 IF ((SORT="S")!((SORT="P")&(ORQTYP'="C")))
Begin DoDot:3
+113 SET ^TMP("OR",$JOB,"PATIENTS","B",ORQSNM_" "_ORQPNM_" "_ORQPIEN_" "_ORQIDT)=ORQPIEN_U_ORQPNM_U_ORQSSN_U_ORQDOB_U_ORQSNM_U_ORQMORE_U_ORQPTR_U_ORQIDT_U_ORQPSTAT
End DoDot:3
QUIT
+114 ;
+115 ; Use source source+app't first if "P" (app't) sort, and a clinic:
+116 IF ((ORQTYP="C")&(SORT="P"))
Begin DoDot:3
+117 SET ^TMP("OR",$JOB,"PATIENTS","B",ORQSNM_" "_ORQIDT_" "_ORQPNM_" "_ORQPIEN)=ORQPIEN_U_ORQPNM_U_ORQSSN_U_ORQDOB_U_ORQSNM_U_ORQMORE_U_ORQPTR_U_ORQIDT_U_ORQPSTAT
End DoDot:3
QUIT
+118 ;
+119 ; If not by source or source/app't, default to alpha ("A") sort:
+120 SET ^TMP("OR",$JOB,"PATIENTS","B",ORQPNM_" "_ORQPIEN_" "_ORQSNM_" "_ORQIDT)=ORQPIEN_U_ORQPNM_U_ORQSSN_U_ORQDOB_U_ORQSNM_U_ORQMORE_U_ORQPTR_U_ORQIDT_U_ORQPSTAT
End DoDot:2
End DoDot:1
+121 ;
+122 QUIT
+123 ;
ID(ORQPIEN) ; Return short ID for patient ID.
+1 ; (Copied from ORQPT routine and modified.)
+2 ;
+3 NEW ID
+4 ;
+5 ; Gets short ID.
SET ID=$PIECE($GET(^DPT(ORQPIEN,.36)),U,4)
+6 ; - or -
IF '$LENGTH(ID)
Begin DoDot:1
+7 ; Last 4 of SSN
SET ID=$EXTRACT($PIECE($GET(^DPT(ORQPIEN,0)),U,9),6,9)
End DoDot:1
+8 ;
+9 QUIT "("_$EXTRACT(ORQPNM)_ID_")"
+10 ;
