- 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 Feb 19, 2025@00:00:03 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 ;