ORQPTQ6 ; SLC/PKS [8/27/03 11:20am];05/21/14 20:20
;;3.0;ORDER ENTRY/RESULTS REPORTING;**82,85,187,320,377**;Dec 17, 1997;Build 582
;
; Called by BUILD^ORQPT (LM) and DEFLIST^ORQPTQ11 (GUI).
;
Q
;
COMBPTS(ORQLM,ORQCPTR,ORBDATE,OREDATE) ; Build "Combination" pt. list.
; SLC/PKS.
;
; NOTE: Any calls to this tag need to deal with ORQLM passed
; variable appropriately. Notice where it is evaluated
; and make sure code specifies the setting of ORQLM (a
; boolean variable) properly for the call.
;
; Variables used:
;
; MSG = Holds error message, if any.
; ORBDATE = PASSED: Beginning date for clinic appointments.
; OREDATE = PASSED: End date for clinic appointments.
; ORQCNT = Counter for patients.
; ORQCPTR = PASSED: Combination file [^OR(100.24,] pointer.
; ORQDUZ = DUZ of current user.
; ORQERR = Array for error msg(s) return from DB calls.
; ORQFILE = Combo source entry file.
; ORQLM = PASSED: Called from LM ("1") or GUI ("0")?
; ORQPDAT = String holder for arrays and ^TMP file values.
; ORQPDOB = Patient DOB.
; ORQPFMDT = Hold app't date/time in FM internal format.
; ORQPIEN = Variable for patient IEN, ^TMP("OR",$J,"PTSCOMBO")
; ORQPMOR = Appointment or Room/Bed information.
; ORQPNM = Variable for patient name, ^TMP("OR",$J,"PTSCOMBO")
; ORQPSNM = Source name display string holder.
; ORQPSSN = Patient ID (first letter of last name, last 4 SSN).
; ORQPSTAT = Ipt or Opt (or C/NS) status for clinic lists.
; ORQPTMP = Temporary string construction holder.
; ORQPTR = Pointer to combo source entry.
; ORQRTN = Holds return value from DB calls.
; ORQSPCH = Holds return value from SELCHK^ORWPT.
; ORQSRC = Variable to hold each combo source subscript.
; ORQSRCID = IEN of source.
; ORQTXT = Variable to hold stored values.
; ORY = Array used in sub-calls.
;
; (NOTE: LCNT,LIST,MSG,NUM,SORT new'd in calling routines for LM.)
;
N ORQCNT,ORQDUZ,ORQERR,ORQFILE,ORQPCNT,ORQPDAT,ORQPDOB,ORQPFMDT,ORQPIEN,ORQPNM,ORQPMOR,ORQPSNM,ORQPSSN,ORQPSTAT,ORQPTMP,ORQPTR,ORQRTN,ORQSPCH,ORQSRC,ORQSRCID,ORQTXT,ORY,MAXAPPTS
;
K ^TMP("OR",$J,"PATIENTS") ; Safety cleanup.
;
; Do preliminary settings, cleanup, look for an existing user record:
S MSG="" ; Default.
S MAXAPPTS=$S(ORBDATE=OREDATE:0,1:200) ; If date range is only one day then no max, otherwise 200
I '$D(DUZ) D
.S MSG="No user DUZ info."
.I 'ORQLM D GUIABORT
.Q
S ORQDUZ=DUZ
K ORQERR
S ORQRTN=$$FIND1^DIC(100.24,"","QX",ORQDUZ,"","","ORQERR")
K ORQERR
D CLEAN^DILF ; Clean up after DB call.
;
; If no combination record, then punt:
I +ORQRTN<1 D
.S MSG="No combination entry."
.I 'ORQLM D GUIABORT
.Q
;
I ORQLM D CLEAN^VALM10 ; VALM housekeeping.
;
; Order through the user's combination source entries:
I 'ORQLM S SORT="A" ; Required variable for PTSCOMBO^ORQPTQ5.
S ORQSRC=0
F S ORQSRC=$O(^OR(100.24,ORQRTN,.01,ORQSRC)) Q:'ORQSRC D
.K ORY ; Clean up each time.
.S ORQTXT="" ; Initialize.
.S ORQTXT=$G(^OR(100.24,ORQRTN,.01,ORQSRC,0)) ; Get record's value.
.;
.; In case of error, punt:
.I ORQTXT="" D
..S MSG="Combination source entry error."
..I 'ORQLM D GUIABORT ; GUI is different.
..Q
.I ORQTXT="" Q
.S ORQPTR=$P(ORQTXT,";") ; Get pointer.
.S ORQFILE="^"_$P(ORQTXT,";",2) ; Get file.
.;
.; Get info for each source entry and build ORY array accordingly.
.I ORQFILE="^DIC(42," D Q ; Wards.
..D WARDPTS^ORQPTQ2(.ORY,ORQPTR)
..I $D(ORY) D PTSCOMBO^ORQPTQ5("W",ORQPTR) ; Process ORY array.
.I ORQFILE="^VA(200," D Q ; Providers.
..D PROVPTS^ORQPTQ2(.ORY,ORQPTR)
..I $D(ORY) D PTSCOMBO^ORQPTQ5("P",ORQPTR) ; Process ORY array.
.I ORQFILE="^DIC(45.7," D Q ; Specialties.
..D SPECPTS^ORQPTQ2(.ORY,ORQPTR)
..I $D(ORY) D PTSCOMBO^ORQPTQ5("S",ORQPTR) ; Process ORY array.
.I ORQFILE="^OR(100.21," D Q ; Team Lists
..D TEAMPTS^ORQPTQ1(.ORY,ORQPTR)
..I $D(ORY) D PTSCOMBO^ORQPTQ5("T",ORQPTR) ; Process ORY array.
.I ORQFILE="^SC(" D Q ; Clinics.
..N APPTBGN,APPTEND S (APPTBGN,APPTEND)=""
..D CLINPTS^ORQPTQ2(.ORY,ORQPTR,ORBDATE,OREDATE,MAXAPPTS,.APPTBGN,.APPTEND)
..I $D(ORY) D PTSCOMBO^ORQPTQ5("C",ORQPTR,APPTEND) ; Process ORY array.
.; TDP 5/21/2014 - Added PCMM Team List
.I ORQFILE="^SCTM(404.51," D Q ; PCMM Team Lists.
..D PTEAMPTS^ORQPTQ1(.ORY,ORQPTR)
..I $D(ORY) D PTSCOMBO^ORQPTQ5("E",ORQPTR) ; Process ORY array.
;
; Order thru ^TMP file "B" node entries returned by previous calls:
S ORQCNT=0 ; Reset for final use.
I $D(^TMP("OR",$J,"PATIENTS")) D
.S ORQPDAT=""
.F S ORQPDAT=$O(^TMP("OR",$J,"PATIENTS","B",ORQPDAT)) Q:ORQPDAT="" D
..;
..; Clear variables each time through:
..S (ORQTXT,ORQPFMDT,ORQPIEN,ORQPNM,ORQPSSN,ORQPSTAT,ORQPDOB,ORQPSNM,ORQPMOR,ORQSRCID)=""
..;
..; Retrieve node's value:
..S ORQTXT=$G(^TMP("OR",$J,"PATIENTS","B",ORQPDAT))
..;
..; Set indvidual variables:
..S ORQPIEN=$P(ORQTXT,U) ; Patient DFN.
..S ORQPNM=$P(ORQTXT,U,2) ; Patient name.
..S ORQPSSN=$P(ORQTXT,U,3) ; Patient ID.
..S ORQPDOB=$P(ORQTXT,U,4) ; Patient DOB.
..S ORQPSNM=$P(ORQTXT,U,5) ; Source data.
..S ORQPMOR=$P(ORQTXT,U,6) ; App't or R/B info.
..S ORQSRCID=$P(ORQTXT,U,7) ; Source IEN.
..S ORQPFMDT=$P(ORQTXT,U,8) ; App't FM date/time.
..S ORQPSTAT=$P(ORQTXT,U,9) ; Ipt/Opt status.
..S ORQCNT=ORQCNT+1 ; Increment counter.
..;
..; If a "sensitive" patient, reassign SSN, DOB data:
..S ORQSPCH=$$SSN^DPTLK1(ORQPIEN)
..I ORQSPCH["*" S ORQPSSN=""
..S ORQPDOB=$$DOB^DPTLK1(ORQPIEN)
..;
..; Make some preliminary data settings:
..S ORQPTMP=""
..I ORQPSNM'="" S ORQPTMP=ORQPSNM_" "
..S ORQPTMP=ORQPTMP_ORQPMOR
..;
..; Write new ^TMP file "PATIENTS" nodes:
..I ORQLM D ; For LM.
...S ^TMP("OR",$J,"PATIENTS","IDX",ORQCNT)=ORQPIEN_U_ORQPNM
...S ^TMP("OR",$J,"PATIENTS",ORQCNT,0)=$$LJ^XLFSTR(ORQCNT,5)_$$LJ^XLFSTR(ORQPNM,31)_$$LJ^XLFSTR(ORQPSSN,10)_$$LJ^XLFSTR(ORQPDOB,15)_ORQPTMP_$$LJ^XLFSTR(ORQPDOB,15)_$$RJ^XLFSTR(ORQSRCID,8)_" "_ORQPFMDT
...D CNTRL^VALM10(ORQCNT,1,5,IOINHI,IOINORM)
..;
..I 'ORQLM D ; For GUI.
...S ORQTXT=ORQPIEN_U_ORQPNM_U_ORQPSNM_U_ORQPMOR_U_ORQPSSN_U_ORQPDOB_U_ORQSRCID_U_ORQPFMDT_U_ORQPSTAT
...S ^TMP("OR",$J,"PATIENTS",ORQCNT,0)=ORQTXT ; Actual global write.
;
; Set counters for return, if applicable; do cleanup:
I ORQCNT S (LCNT,NUM)=ORQCNT
K ORY
;
; If no patients found, prepare user message:
I 'ORQCNT S MSG="No patients found."
;
; If an error message exists, dump any partial processing and quit:
I MSG'="" D Q
.I 'ORQLM D GUIABORT
.I ORQLM K ^TMP("OR",$J,"PATIENTS")
;
; Next lines create #line^^#pts^context value entry:
I ORQLM D
.S ^TMP("OR",$J,"PATIENTS",0)=ORQCNT_U_ORQCNT_U_$G(LIST)
.S ^TMP("OR",$J,"PATIENTS","#")=$O(^ORD(101,"B","ORQPT SELECT PATIENT",0))_"^1:"_ORQCNT
;
; Standard clean-up for GUI:
I 'ORQLM D
.K LCNT,LIST,MSG,NUM,SORT
.K ^TMP("OR",$J,"PATIENTS","B")
;
Q
;
GUIABORT ; Cleanup when aborting when called from GUI.
;
K ^TMP("OR",$J,"PATIENTS")
S ^TMP("OR",$J,"PATIENTS",0)=""
K LCNT,LIST,MSG,NUM,SORT
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQPTQ6 7874 printed Oct 16, 2024@18:34:06 Page 2
ORQPTQ6 ; SLC/PKS [8/27/03 11:20am];05/21/14 20:20
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**82,85,187,320,377**;Dec 17, 1997;Build 582
+2 ;
+3 ; Called by BUILD^ORQPT (LM) and DEFLIST^ORQPTQ11 (GUI).
+4 ;
+5 QUIT
+6 ;
COMBPTS(ORQLM,ORQCPTR,ORBDATE,OREDATE) ; Build "Combination" pt. list.
+1 ; SLC/PKS.
+2 ;
+3 ; NOTE: Any calls to this tag need to deal with ORQLM passed
+4 ; variable appropriately. Notice where it is evaluated
+5 ; and make sure code specifies the setting of ORQLM (a
+6 ; boolean variable) properly for the call.
+7 ;
+8 ; Variables used:
+9 ;
+10 ; MSG = Holds error message, if any.
+11 ; ORBDATE = PASSED: Beginning date for clinic appointments.
+12 ; OREDATE = PASSED: End date for clinic appointments.
+13 ; ORQCNT = Counter for patients.
+14 ; ORQCPTR = PASSED: Combination file [^OR(100.24,] pointer.
+15 ; ORQDUZ = DUZ of current user.
+16 ; ORQERR = Array for error msg(s) return from DB calls.
+17 ; ORQFILE = Combo source entry file.
+18 ; ORQLM = PASSED: Called from LM ("1") or GUI ("0")?
+19 ; ORQPDAT = String holder for arrays and ^TMP file values.
+20 ; ORQPDOB = Patient DOB.
+21 ; ORQPFMDT = Hold app't date/time in FM internal format.
+22 ; ORQPIEN = Variable for patient IEN, ^TMP("OR",$J,"PTSCOMBO")
+23 ; ORQPMOR = Appointment or Room/Bed information.
+24 ; ORQPNM = Variable for patient name, ^TMP("OR",$J,"PTSCOMBO")
+25 ; ORQPSNM = Source name display string holder.
+26 ; ORQPSSN = Patient ID (first letter of last name, last 4 SSN).
+27 ; ORQPSTAT = Ipt or Opt (or C/NS) status for clinic lists.
+28 ; ORQPTMP = Temporary string construction holder.
+29 ; ORQPTR = Pointer to combo source entry.
+30 ; ORQRTN = Holds return value from DB calls.
+31 ; ORQSPCH = Holds return value from SELCHK^ORWPT.
+32 ; ORQSRC = Variable to hold each combo source subscript.
+33 ; ORQSRCID = IEN of source.
+34 ; ORQTXT = Variable to hold stored values.
+35 ; ORY = Array used in sub-calls.
+36 ;
+37 ; (NOTE: LCNT,LIST,MSG,NUM,SORT new'd in calling routines for LM.)
+38 ;
+39 NEW ORQCNT,ORQDUZ,ORQERR,ORQFILE,ORQPCNT,ORQPDAT,ORQPDOB,ORQPFMDT,ORQPIEN,ORQPNM,ORQPMOR,ORQPSNM,ORQPSSN,ORQPSTAT,ORQPTMP,ORQPTR,ORQRTN,ORQSPCH,ORQSRC,ORQSRCID,ORQTXT,ORY,MAXAPPTS
+40 ;
+41 ; Safety cleanup.
KILL ^TMP("OR",$JOB,"PATIENTS")
+42 ;
+43 ; Do preliminary settings, cleanup, look for an existing user record:
+44 ; Default.
SET MSG=""
+45 ; If date range is only one day then no max, otherwise 200
SET MAXAPPTS=$SELECT(ORBDATE=OREDATE:0,1:200)
+46 IF '$DATA(DUZ)
Begin DoDot:1
+47 SET MSG="No user DUZ info."
+48 IF 'ORQLM
DO GUIABORT
+49 QUIT
End DoDot:1
+50 SET ORQDUZ=DUZ
+51 KILL ORQERR
+52 SET ORQRTN=$$FIND1^DIC(100.24,"","QX",ORQDUZ,"","","ORQERR")
+53 KILL ORQERR
+54 ; Clean up after DB call.
DO CLEAN^DILF
+55 ;
+56 ; If no combination record, then punt:
+57 IF +ORQRTN<1
Begin DoDot:1
+58 SET MSG="No combination entry."
+59 IF 'ORQLM
DO GUIABORT
+60 QUIT
End DoDot:1
+61 ;
+62 ; VALM housekeeping.
IF ORQLM
DO CLEAN^VALM10
+63 ;
+64 ; Order through the user's combination source entries:
+65 ; Required variable for PTSCOMBO^ORQPTQ5.
IF 'ORQLM
SET SORT="A"
+66 SET ORQSRC=0
+67 FOR
SET ORQSRC=$ORDER(^OR(100.24,ORQRTN,.01,ORQSRC))
if 'ORQSRC
QUIT
Begin DoDot:1
+68 ; Clean up each time.
KILL ORY
+69 ; Initialize.
SET ORQTXT=""
+70 ; Get record's value.
SET ORQTXT=$GET(^OR(100.24,ORQRTN,.01,ORQSRC,0))
+71 ;
+72 ; In case of error, punt:
+73 IF ORQTXT=""
Begin DoDot:2
+74 SET MSG="Combination source entry error."
+75 ; GUI is different.
IF 'ORQLM
DO GUIABORT
+76 QUIT
End DoDot:2
+77 IF ORQTXT=""
QUIT
+78 ; Get pointer.
SET ORQPTR=$PIECE(ORQTXT,";")
+79 ; Get file.
SET ORQFILE="^"_$PIECE(ORQTXT,";",2)
+80 ;
+81 ; Get info for each source entry and build ORY array accordingly.
+82 ; Wards.
IF ORQFILE="^DIC(42,"
Begin DoDot:2
+83 DO WARDPTS^ORQPTQ2(.ORY,ORQPTR)
+84 ; Process ORY array.
IF $DATA(ORY)
DO PTSCOMBO^ORQPTQ5("W",ORQPTR)
End DoDot:2
QUIT
+85 ; Providers.
IF ORQFILE="^VA(200,"
Begin DoDot:2
+86 DO PROVPTS^ORQPTQ2(.ORY,ORQPTR)
+87 ; Process ORY array.
IF $DATA(ORY)
DO PTSCOMBO^ORQPTQ5("P",ORQPTR)
End DoDot:2
QUIT
+88 ; Specialties.
IF ORQFILE="^DIC(45.7,"
Begin DoDot:2
+89 DO SPECPTS^ORQPTQ2(.ORY,ORQPTR)
+90 ; Process ORY array.
IF $DATA(ORY)
DO PTSCOMBO^ORQPTQ5("S",ORQPTR)
End DoDot:2
QUIT
+91 ; Team Lists
IF ORQFILE="^OR(100.21,"
Begin DoDot:2
+92 DO TEAMPTS^ORQPTQ1(.ORY,ORQPTR)
+93 ; Process ORY array.
IF $DATA(ORY)
DO PTSCOMBO^ORQPTQ5("T",ORQPTR)
End DoDot:2
QUIT
+94 ; Clinics.
IF ORQFILE="^SC("
Begin DoDot:2
+95 NEW APPTBGN,APPTEND
SET (APPTBGN,APPTEND)=""
+96 DO CLINPTS^ORQPTQ2(.ORY,ORQPTR,ORBDATE,OREDATE,MAXAPPTS,.APPTBGN,.APPTEND)
+97 ; Process ORY array.
IF $DATA(ORY)
DO PTSCOMBO^ORQPTQ5("C",ORQPTR,APPTEND)
End DoDot:2
QUIT
+98 ; TDP 5/21/2014 - Added PCMM Team List
+99 ; PCMM Team Lists.
IF ORQFILE="^SCTM(404.51,"
Begin DoDot:2
+100 DO PTEAMPTS^ORQPTQ1(.ORY,ORQPTR)
+101 ; Process ORY array.
IF $DATA(ORY)
DO PTSCOMBO^ORQPTQ5("E",ORQPTR)
End DoDot:2
QUIT
End DoDot:1
+102 ;
+103 ; Order thru ^TMP file "B" node entries returned by previous calls:
+104 ; Reset for final use.
SET ORQCNT=0
+105 IF $DATA(^TMP("OR",$JOB,"PATIENTS"))
Begin DoDot:1
+106 SET ORQPDAT=""
+107 FOR
SET ORQPDAT=$ORDER(^TMP("OR",$JOB,"PATIENTS","B",ORQPDAT))
if ORQPDAT=""
QUIT
Begin DoDot:2
+108 ;
+109 ; Clear variables each time through:
+110 SET (ORQTXT,ORQPFMDT,ORQPIEN,ORQPNM,ORQPSSN,ORQPSTAT,ORQPDOB,ORQPSNM,ORQPMOR,ORQSRCID)=""
+111 ;
+112 ; Retrieve node's value:
+113 SET ORQTXT=$GET(^TMP("OR",$JOB,"PATIENTS","B",ORQPDAT))
+114 ;
+115 ; Set indvidual variables:
+116 ; Patient DFN.
SET ORQPIEN=$PIECE(ORQTXT,U)
+117 ; Patient name.
SET ORQPNM=$PIECE(ORQTXT,U,2)
+118 ; Patient ID.
SET ORQPSSN=$PIECE(ORQTXT,U,3)
+119 ; Patient DOB.
SET ORQPDOB=$PIECE(ORQTXT,U,4)
+120 ; Source data.
SET ORQPSNM=$PIECE(ORQTXT,U,5)
+121 ; App't or R/B info.
SET ORQPMOR=$PIECE(ORQTXT,U,6)
+122 ; Source IEN.
SET ORQSRCID=$PIECE(ORQTXT,U,7)
+123 ; App't FM date/time.
SET ORQPFMDT=$PIECE(ORQTXT,U,8)
+124 ; Ipt/Opt status.
SET ORQPSTAT=$PIECE(ORQTXT,U,9)
+125 ; Increment counter.
SET ORQCNT=ORQCNT+1
+126 ;
+127 ; If a "sensitive" patient, reassign SSN, DOB data:
+128 SET ORQSPCH=$$SSN^DPTLK1(ORQPIEN)
+129 IF ORQSPCH["*"
SET ORQPSSN=""
+130 SET ORQPDOB=$$DOB^DPTLK1(ORQPIEN)
+131 ;
+132 ; Make some preliminary data settings:
+133 SET ORQPTMP=""
+134 IF ORQPSNM'=""
SET ORQPTMP=ORQPSNM_" "
+135 SET ORQPTMP=ORQPTMP_ORQPMOR
+136 ;
+137 ; Write new ^TMP file "PATIENTS" nodes:
+138 ; For LM.
IF ORQLM
Begin DoDot:3
+139 SET ^TMP("OR",$JOB,"PATIENTS","IDX",ORQCNT)=ORQPIEN_U_ORQPNM
+140 SET ^TMP("OR",$JOB,"PATIENTS",ORQCNT,0)=$$LJ^XLFSTR(ORQCNT,5)_$$LJ^XLFSTR(ORQPNM,31)_$$LJ^XLFSTR(ORQPSSN,10)_$$LJ^XLFSTR(ORQPDOB,15)_ORQPTMP_$$LJ^XLFSTR(ORQPDOB,15)_$$RJ^XLFSTR(ORQSRCID,8)_" "_ORQPFMDT
+141 DO CNTRL^VALM10(ORQCNT,1,5,IOINHI,IOINORM)
End DoDot:3
+142 ;
+143 ; For GUI.
IF 'ORQLM
Begin DoDot:3
+144 SET ORQTXT=ORQPIEN_U_ORQPNM_U_ORQPSNM_U_ORQPMOR_U_ORQPSSN_U_ORQPDOB_U_ORQSRCID_U_ORQPFMDT_U_ORQPSTAT
+145 ; Actual global write.
SET ^TMP("OR",$JOB,"PATIENTS",ORQCNT,0)=ORQTXT
End DoDot:3
End DoDot:2
End DoDot:1
+146 ;
+147 ; Set counters for return, if applicable; do cleanup:
+148 IF ORQCNT
SET (LCNT,NUM)=ORQCNT
+149 KILL ORY
+150 ;
+151 ; If no patients found, prepare user message:
+152 IF 'ORQCNT
SET MSG="No patients found."
+153 ;
+154 ; If an error message exists, dump any partial processing and quit:
+155 IF MSG'=""
Begin DoDot:1
+156 IF 'ORQLM
DO GUIABORT
+157 IF ORQLM
KILL ^TMP("OR",$JOB,"PATIENTS")
End DoDot:1
QUIT
+158 ;
+159 ; Next lines create #line^^#pts^context value entry:
+160 IF ORQLM
Begin DoDot:1
+161 SET ^TMP("OR",$JOB,"PATIENTS",0)=ORQCNT_U_ORQCNT_U_$GET(LIST)
+162 SET ^TMP("OR",$JOB,"PATIENTS","#")=$ORDER(^ORD(101,"B","ORQPT SELECT PATIENT",0))_"^1:"_ORQCNT
End DoDot:1
+163 ;
+164 ; Standard clean-up for GUI:
+165 IF 'ORQLM
Begin DoDot:1
+166 KILL LCNT,LIST,MSG,NUM,SORT
+167 KILL ^TMP("OR",$JOB,"PATIENTS","B")
End DoDot:1
+168 ;
+169 QUIT
+170 ;
GUIABORT ; Cleanup when aborting when called from GUI.
+1 ;
+2 KILL ^TMP("OR",$JOB,"PATIENTS")
+3 SET ^TMP("OR",$JOB,"PATIENTS",0)=""
+4 KILL LCNT,LIST,MSG,NUM,SORT
+5 ;
+6 QUIT
+7 ;
