DGQPTQ6 ; SLC/PKS - Combination pt. list cont. ;6/5/01 12:38pm
;;5.3;Registration;**447,1015**;Aug 13, 1993;Build 21
;
; Called by BUILD^DGQPT
;
Q
;
COMBPTS(DGQLM,DGQCPTR,DGBDATE,DGEDATE) ; Build "Combination" pt. list.
; SLC/PKS.
;
; NOTE: Any calls to this tag need to deal with DGQLM passed
; variable appropriately. Notice where it is evaluated
; and make sure code specifies the setting of DGQLM (a
; boolean variable) properly for the call.
;
; Variables used:
;
; MSG = Holds error message, if any.
; DGBDATE = PASSED: Beginning date for clinic appointments.
; DGEDATE = PASSED: End date for clinic appointments.
; DGQCNT = Counter for patients.
; DGQCPTR = PASSED: Combination file [^OR(100.24,] pointer.
; DGQDUZ = DUZ of current user.
; DGQERR = Array for error msg(s) return from DB calls.
; DGQFILE = Combo source entry file.
; DGQLM = PASSED: Called from LM ("1") or GUI ("0")?
; DGQPDAT = String holder for arrays and ^TMP file values.
; DGQPDOB = Patient DOB.
; DGQPFMDT = Hold app't date/time in FM internal format.
; DGQPIEN = Variable for patient IEN, ^TMP("DG",$J,"PTSCOMBO")
; DGQPMOR = Appointment or Room/Bed information.
; DGQPNM = Variable for patient name, ^TMP("DG",$J,"PTSCOMBO")
; DGQPSNM = Source name display string holder.
; DGQPSSN = Patient ID (first letter of last name, last 4 SSN).
; DGQPTMP = Temporary string construction holder.
; DGQPTR = Pointer to combo source entry.
; DGQRTN = Holds return value from DB calls.
; DGQSPCH = Holds return value from SELCHK^DGWPT.
; DGQSRC = Variable to hold each combo source subscript.
; DGQSRCID = IEN of source.
; DGQTXT = Variable to hold stored values.
; DGY = Array used in sub-calls.
;
; (NOTE: LCNT,LIST,MSG,NUM,SORT new'd in calling routines for LM.)
;
N DGQCNT,DGQDUZ,DGQERR,DGQFILE,DGQPCNT,DGQPDAT,DGQPDOB,DGQPFMDT,DGQPIEN,DGQPNM,DGQPMOR,DGQPSNM,DGQPSSN,DGQPTMP,DGQPTR,DGQRTN,DGQSPCH,DGQSRC,DGQSRCID,DGQTXT,DGY
;
K ^TMP("DG",$J,"PATIENTS") ; Safety cleanup.
;
; Do preliminary settings, cleanup, look for an existing user record:
S MSG="" ; Default.
I '$D(DUZ) D
.S MSG="No user DUZ info."
.I 'DGQLM D GUIABORT
.Q
S DGQDUZ=DUZ
K DGQERR
S DGQRTN=$$FIND1^DIC(100.24,"","QX",DGQDUZ,"","","DGQERR")
K DGQERR
D CLEAN^DILF ; Clean up after DB call.
;
; If no combination record, then punt:
I +DGQRTN<1 D
.S MSG="No combination entry."
.I 'DGQLM D GUIABORT
.Q
;
I DGQLM D CLEAN^VALM10 ; VALM housekeeping.
;
; Order through the user's combination source entries:
I 'DGQLM S SORT="A" ; Required variable for PTSCOMBO^ORQPTQ5.
S DGQSRC=0
F S DGQSRC=$O(^OR(100.24,DGQRTN,.01,DGQSRC)) Q:'DGQSRC D
.K DGY ; Clean up each time.
.S DGQTXT="" ; Initialize.
.S DGQTXT=$G(^OR(100.24,DGQRTN,.01,DGQSRC,0)) ; Get record's value.
.;
.; In case of error, punt:
.I DGQTXT="" D
..S MSG="Combination source entry error."
..I 'DGQLM D GUIABORT ; GUI is different.
..Q
.I DGQTXT="" Q
.S DGQPTR=$P(DGQTXT,";") ; Get pointer.
.S DGQFILE="^"_$P(DGQTXT,";",2) ; Get file.
.;
.; Get info for each source entry and build DGY array accordingly.
.I DGQFILE="^DIC(42," D Q ; Wards.
..D WARDPTS^DGQPTQ2(.DGY,DGQPTR)
..I $D(DGY) D PTSCOMBO^DGQPTQ5("W",DGQPTR) ; Process DGY array.
.I DGQFILE="^VA(200," D Q ; Providers.
..D PROVPTS^DGQPTQ2(.DGY,DGQPTR)
..I $D(DGY) D PTSCOMBO^DGQPTQ5("P",DGQPTR) ; Process DGY array.
.I DGQFILE="^DIC(45.7," D Q ; Specialties.
..D SPECPTS^DGQPTQ2(.DGY,DGQPTR)
..I $D(DGY) D PTSCOMBO^DGQPTQ5("S",DGQPTR) ; Process DGY array.
.I DGQFILE="^OR(100.21," D Q ; Team Lists
..D TEAMPTS^DGQPTQ1(.DGY,DGQPTR)
..I $D(DGY) D PTSCOMBO^DGQPTQ5("T",DGQPTR) ; Process DGY array.
.I DGQFILE="^SC(" D Q ; Clinics.
..D CLINPTS^DGQPTQ2(.DGY,DGQPTR,DGBDATE,DGEDATE)
..I $D(DGY) D PTSCOMBO^DGQPTQ5("C",DGQPTR) ; Process DGY array.
;
; Order thru ^TMP file "B" node entries returned by previous calls:
S DGQCNT=0 ; Reset for final use.
I $D(^TMP("DG",$J,"PATIENTS")) D
.S DGQPDAT=""
.F S DGQPDAT=$O(^TMP("DG",$J,"PATIENTS","B",DGQPDAT)) Q:DGQPDAT="" D
..;
..; Clear variables each time through:
..S (DGQTXT,DGQPFMDT,DGQPIEN,DGQPNM,DGQPSSN,DGQPDOB,DGQPSNM,DGQPMOR,DGQSRCID)=""
..;
..; Retrieve node's value:
..S DGQTXT=$G(^TMP("DG",$J,"PATIENTS","B",DGQPDAT))
..;
..; Set indvidual variables:
..S DGQPIEN=$P(DGQTXT,U) ; Patient DFN.
..S DGQPNM=$P(DGQTXT,U,2) ; Patient name.
..S DGQPSSN=$P(DGQTXT,U,3) ; Patient ID.
..S DGQPDOB=$P(DGQTXT,U,4) ; Patient DOB.
..S DGQPSNM=$P(DGQTXT,U,5) ; Source data.
..S DGQPMOR=$P(DGQTXT,U,6) ; App't or R/B info.
..S DGQSRCID=$P(DGQTXT,U,7) ; Source IEN.
..S DGQPFMDT=$P(DGQTXT,U,8) ; App't FM date/time.
..S DGQCNT=DGQCNT+1 ; Increment counter.
..;
..; If a "sensitive" patient, reassign SSN, DOB data:
..S DGQSPCH=$$SSN^DPTLK1(DGQPIEN)
..I DGQSPCH["*" S DGQPSSN=""
..S DGQPDOB=$$DOB^DPTLK1(DGQPIEN)
..;
..; Make some preliminary data settings:
..S DGQPTMP=""
..I DGQPSNM'="" S DGQPTMP=DGQPSNM_" "
..S DGQPTMP=DGQPTMP_DGQPMOR
..;
..; Write new ^TMP file "PATIENTS" nodes:
..I DGQLM D ; For LM.
...S ^TMP("DG",$J,"PATIENTS","IDX",DGQCNT)=DGQPIEN_U_DGQPNM
...S ^TMP("DG",$J,"PATIENTS",DGQCNT,0)=$$LJ^XLFSTR(DGQCNT,5)_$$LJ^XLFSTR(DGQPNM,31)_$$LJ^XLFSTR(DGQPSSN,10)_$$LJ^XLFSTR(DGQPDOB,15)_DGQPTMP_$$LJ^XLFSTR(DGQPDOB,15)_$$RJ^XLFSTR(DGQSRCID,8)_" "_DGQPFMDT
...D CNTRL^VALM10(DGQCNT,1,5,IOINHI,IOINORM)
..;
..I 'DGQLM D ; For GUI.
...S DGQTXT=DGQPIEN_U_DGQPNM_U_DGQPSNM_U_DGQPMOR_U_DGQPSSN_U_DGQPDOB_U_DGQSRCID_U_DGQPFMDT
...S ^TMP("DG",$J,"PATIENTS",DGQCNT,0)=DGQTXT ; Actual global write.
;
; Set counters for return, if applicable; do cleanup:
I DGQCNT S (LCNT,NUM)=DGQCNT
K DGY
;
; If no patients found, prepare user message:
I 'DGQCNT S MSG="No patients found."
;
; If an error message exists, dump any partial processing and quit:
I MSG'="" D Q
.I 'DGQLM D GUIABORT
.I DGQLM K ^TMP("DG",$J,"PATIENTS")
;
; Next lines create #line^^#pts^context value entry:
I DGQLM D
.S ^TMP("DG",$J,"PATIENTS",0)=DGQCNT_U_DGQCNT_U_$G(LIST)
.S ^TMP("DG",$J,"PATIENTS","#")=$O(^ORD(101,"B","ORQPT SELECT PATIENT",0))_"^1:"_DGQCNT
;
; Standard clean-up for GUI:
I 'DGQLM D
.K LCNT,LIST,MSG,NUM,SORT
.K ^TMP("DG",$J,"PATIENTS","B")
;
Q
;
GUIABORT ; Cleanup when aborting when called from GUI.
;
K ^TMP("DG",$J,"PATIENTS")
S ^TMP("DG",$J,"PATIENTS",0)=""
K LCNT,LIST,MSG,NUM,SORT
;
Q
;
DGQPTQ6 ; SLC/PKS - Combination pt. list cont. ;6/5/01 12:38pm
+1 ;;5.3;Registration;**447,1015**;Aug 13, 1993;Build 21
+2 ;
+3 ; Called by BUILD^DGQPT
+4 ;
+5 QUIT
+6 ;
COMBPTS(DGQLM,DGQCPTR,DGBDATE,DGEDATE) ; Build "Combination" pt. list.
+1 ; SLC/PKS.
+2 ;
+3 ; NOTE: Any calls to this tag need to deal with DGQLM passed
+4 ; variable appropriately. Notice where it is evaluated
+5 ; and make sure code specifies the setting of DGQLM (a
+6 ; boolean variable) properly for the call.
+7 ;
+8 ; Variables used:
+9 ;
+10 ; MSG = Holds error message, if any.
+11 ; DGBDATE = PASSED: Beginning date for clinic appointments.
+12 ; DGEDATE = PASSED: End date for clinic appointments.
+13 ; DGQCNT = Counter for patients.
+14 ; DGQCPTR = PASSED: Combination file [^OR(100.24,] pointer.
+15 ; DGQDUZ = DUZ of current user.
+16 ; DGQERR = Array for error msg(s) return from DB calls.
+17 ; DGQFILE = Combo source entry file.
+18 ; DGQLM = PASSED: Called from LM ("1") or GUI ("0")?
+19 ; DGQPDAT = String holder for arrays and ^TMP file values.
+20 ; DGQPDOB = Patient DOB.
+21 ; DGQPFMDT = Hold app't date/time in FM internal format.
+22 ; DGQPIEN = Variable for patient IEN, ^TMP("DG",$J,"PTSCOMBO")
+23 ; DGQPMOR = Appointment or Room/Bed information.
+24 ; DGQPNM = Variable for patient name, ^TMP("DG",$J,"PTSCOMBO")
+25 ; DGQPSNM = Source name display string holder.
+26 ; DGQPSSN = Patient ID (first letter of last name, last 4 SSN).
+27 ; DGQPTMP = Temporary string construction holder.
+28 ; DGQPTR = Pointer to combo source entry.
+29 ; DGQRTN = Holds return value from DB calls.
+30 ; DGQSPCH = Holds return value from SELCHK^DGWPT.
+31 ; DGQSRC = Variable to hold each combo source subscript.
+32 ; DGQSRCID = IEN of source.
+33 ; DGQTXT = Variable to hold stored values.
+34 ; DGY = Array used in sub-calls.
+35 ;
+36 ; (NOTE: LCNT,LIST,MSG,NUM,SORT new'd in calling routines for LM.)
+37 ;
+38 NEW DGQCNT,DGQDUZ,DGQERR,DGQFILE,DGQPCNT,DGQPDAT,DGQPDOB,DGQPFMDT,DGQPIEN,DGQPNM,DGQPMOR,DGQPSNM,DGQPSSN,DGQPTMP,DGQPTR,DGQRTN,DGQSPCH,DGQSRC,DGQSRCID,DGQTXT,DGY
+39 ;
+40 ; Safety cleanup.
KILL ^TMP("DG",$JOB,"PATIENTS")
+41 ;
+42 ; Do preliminary settings, cleanup, look for an existing user record:
+43 ; Default.
SET MSG=""
+44 IF '$DATA(DUZ)
Begin DoDot:1
+45 SET MSG="No user DUZ info."
+46 IF 'DGQLM
DO GUIABORT
+47 QUIT
End DoDot:1
+48 SET DGQDUZ=DUZ
+49 KILL DGQERR
+50 SET DGQRTN=$$FIND1^DIC(100.24,"","QX",DGQDUZ,"","","DGQERR")
+51 KILL DGQERR
+52 ; Clean up after DB call.
DO CLEAN^DILF
+53 ;
+54 ; If no combination record, then punt:
+55 IF +DGQRTN<1
Begin DoDot:1
+56 SET MSG="No combination entry."
+57 IF 'DGQLM
DO GUIABORT
+58 QUIT
End DoDot:1
+59 ;
+60 ; VALM housekeeping.
IF DGQLM
DO CLEAN^VALM10
+61 ;
+62 ; Order through the user's combination source entries:
+63 ; Required variable for PTSCOMBO^ORQPTQ5.
IF 'DGQLM
SET SORT="A"
+64 SET DGQSRC=0
+65 FOR
SET DGQSRC=$ORDER(^OR(100.24,DGQRTN,.01,DGQSRC))
IF 'DGQSRC
QUIT
Begin DoDot:1
+66 ; Clean up each time.
KILL DGY
+67 ; Initialize.
SET DGQTXT=""
+68 ; Get record's value.
SET DGQTXT=$GET(^OR(100.24,DGQRTN,.01,DGQSRC,0))
+69 ;
+70 ; In case of error, punt:
+71 IF DGQTXT=""
Begin DoDot:2
+72 SET MSG="Combination source entry error."
+73 ; GUI is different.
IF 'DGQLM
DO GUIABORT
+74 QUIT
End DoDot:2
+75 IF DGQTXT=""
QUIT
+76 ; Get pointer.
SET DGQPTR=$PIECE(DGQTXT,";")
+77 ; Get file.
SET DGQFILE="^"_$PIECE(DGQTXT,";",2)
+78 ;
+79 ; Get info for each source entry and build DGY array accordingly.
+80 ; Wards.
IF DGQFILE="^DIC(42,"
Begin DoDot:2
+81 DO WARDPTS^DGQPTQ2(.DGY,DGQPTR)
+82 ; Process DGY array.
IF $DATA(DGY)
DO PTSCOMBO^DGQPTQ5("W",DGQPTR)
End DoDot:2
QUIT
+83 ; Providers.
IF DGQFILE="^VA(200,"
Begin DoDot:2
+84 DO PROVPTS^DGQPTQ2(.DGY,DGQPTR)
+85 ; Process DGY array.
IF $DATA(DGY)
DO PTSCOMBO^DGQPTQ5("P",DGQPTR)
End DoDot:2
QUIT
+86 ; Specialties.
IF DGQFILE="^DIC(45.7,"
Begin DoDot:2
+87 DO SPECPTS^DGQPTQ2(.DGY,DGQPTR)
+88 ; Process DGY array.
IF $DATA(DGY)
DO PTSCOMBO^DGQPTQ5("S",DGQPTR)
End DoDot:2
QUIT
+89 ; Team Lists
IF DGQFILE="^OR(100.21,"
Begin DoDot:2
+90 DO TEAMPTS^DGQPTQ1(.DGY,DGQPTR)
+91 ; Process DGY array.
IF $DATA(DGY)
DO PTSCOMBO^DGQPTQ5("T",DGQPTR)
End DoDot:2
QUIT
+92 ; Clinics.
IF DGQFILE="^SC("
Begin DoDot:2
+93 DO CLINPTS^DGQPTQ2(.DGY,DGQPTR,DGBDATE,DGEDATE)
+94 ; Process DGY array.
IF $DATA(DGY)
DO PTSCOMBO^DGQPTQ5("C",DGQPTR)
End DoDot:2
QUIT
End DoDot:1
+95 ;
+96 ; Order thru ^TMP file "B" node entries returned by previous calls:
+97 ; Reset for final use.
SET DGQCNT=0
+98 IF $DATA(^TMP("DG",$JOB,"PATIENTS"))
Begin DoDot:1
+99 SET DGQPDAT=""
+100 FOR
SET DGQPDAT=$ORDER(^TMP("DG",$JOB,"PATIENTS","B",DGQPDAT))
IF DGQPDAT=""
QUIT
Begin DoDot:2
+101 ;
+102 ; Clear variables each time through:
+103 SET (DGQTXT,DGQPFMDT,DGQPIEN,DGQPNM,DGQPSSN,DGQPDOB,DGQPSNM,DGQPMOR,DGQSRCID)=""
+104 ;
+105 ; Retrieve node's value:
+106 SET DGQTXT=$GET(^TMP("DG",$JOB,"PATIENTS","B",DGQPDAT))
+107 ;
+108 ; Set indvidual variables:
+109 ; Patient DFN.
SET DGQPIEN=$PIECE(DGQTXT,U)
+110 ; Patient name.
SET DGQPNM=$PIECE(DGQTXT,U,2)
+111 ; Patient ID.
SET DGQPSSN=$PIECE(DGQTXT,U,3)
+112 ; Patient DOB.
SET DGQPDOB=$PIECE(DGQTXT,U,4)
+113 ; Source data.
SET DGQPSNM=$PIECE(DGQTXT,U,5)
+114 ; App't or R/B info.
SET DGQPMOR=$PIECE(DGQTXT,U,6)
+115 ; Source IEN.
SET DGQSRCID=$PIECE(DGQTXT,U,7)
+116 ; App't FM date/time.
SET DGQPFMDT=$PIECE(DGQTXT,U,8)
+117 ; Increment counter.
SET DGQCNT=DGQCNT+1
+118 ;
+119 ; If a "sensitive" patient, reassign SSN, DOB data:
+120 SET DGQSPCH=$$SSN^DPTLK1(DGQPIEN)
+121 IF DGQSPCH["*"
SET DGQPSSN=""
+122 SET DGQPDOB=$$DOB^DPTLK1(DGQPIEN)
+123 ;
+124 ; Make some preliminary data settings:
+125 SET DGQPTMP=""
+126 IF DGQPSNM'=""
SET DGQPTMP=DGQPSNM_" "
+127 SET DGQPTMP=DGQPTMP_DGQPMOR
+128 ;
+129 ; Write new ^TMP file "PATIENTS" nodes:
+130 ; For LM.
IF DGQLM
Begin DoDot:3
+131 SET ^TMP("DG",$JOB,"PATIENTS","IDX",DGQCNT)=DGQPIEN_U_DGQPNM
+132 SET ^TMP("DG",$JOB,"PATIENTS",DGQCNT,0)=$$LJ^XLFSTR(DGQCNT,5)_$$LJ^XLFSTR(DGQPNM,31)_$$LJ^XLFSTR(DGQPSSN,10)_$$LJ^XLFSTR(DGQPDOB,15)_DGQPTMP_$$LJ^XLFSTR(DGQPDOB,15)_$$RJ^XLFSTR(DGQSRCID,8)_" "_DGQPFMDT
+133 DO CNTRL^VALM10(DGQCNT,1,5,IOINHI,IOINORM)
End DoDot:3
+134 ;
+135 ; For GUI.
IF 'DGQLM
Begin DoDot:3
+136 SET DGQTXT=DGQPIEN_U_DGQPNM_U_DGQPSNM_U_DGQPMOR_U_DGQPSSN_U_DGQPDOB_U_DGQSRCID_U_DGQPFMDT
+137 ; Actual global write.
SET ^TMP("DG",$JOB,"PATIENTS",DGQCNT,0)=DGQTXT
End DoDot:3
End DoDot:2
End DoDot:1
+138 ;
+139 ; Set counters for return, if applicable; do cleanup:
+140 IF DGQCNT
SET (LCNT,NUM)=DGQCNT
+141 KILL DGY
+142 ;
+143 ; If no patients found, prepare user message:
+144 IF 'DGQCNT
SET MSG="No patients found."
+145 ;
+146 ; If an error message exists, dump any partial processing and quit:
+147 IF MSG'=""
Begin DoDot:1
+148 IF 'DGQLM
DO GUIABORT
+149 IF DGQLM
KILL ^TMP("DG",$JOB,"PATIENTS")
End DoDot:1
QUIT
+150 ;
+151 ; Next lines create #line^^#pts^context value entry:
+152 IF DGQLM
Begin DoDot:1
+153 SET ^TMP("DG",$JOB,"PATIENTS",0)=DGQCNT_U_DGQCNT_U_$GET(LIST)
+154 SET ^TMP("DG",$JOB,"PATIENTS","#")=$ORDER(^ORD(101,"B","ORQPT SELECT PATIENT",0))_"^1:"_DGQCNT
End DoDot:1
+155 ;
+156 ; Standard clean-up for GUI:
+157 IF 'DGQLM
Begin DoDot:1
+158 KILL LCNT,LIST,MSG,NUM,SORT
+159 KILL ^TMP("DG",$JOB,"PATIENTS","B")
End DoDot:1
+160 ;
+161 QUIT
+162 ;
GUIABORT ; Cleanup when aborting when called from GUI.
+1 ;
+2 KILL ^TMP("DG",$JOB,"PATIENTS")
+3 SET ^TMP("DG",$JOB,"PATIENTS",0)=""
+4 KILL LCNT,LIST,MSG,NUM,SORT
+5 ;
+6 QUIT
+7 ;
