PXRMINPL ;SLC/RMS,PKR - List computed findings for inpatient info. ; 09/08/2008
;;2.0;CLINICAL REMINDERS;**12**;Feb 04, 2005;Build 73
;=====================================
ADM(NGET,BDT,EDT,PLIST,PARAM) ;All admissions during a date range.
D ADMDISCH(BDT,EDT,PLIST,PARAM,"ATT1")
Q
;
;=====================================
ADMDISCH(BDT,EDT,PLIST,PARAM,SUB) ;Build admission and discharge lists.
;Admissions when SUB="ATT1" and discharges when SUB="ATT3"
;DBIAs (^DIC(4: #2251,#10090), (^DIC(42: #10039),
;(^DGPM: #1480), (^DPT: #187), (^SC: #10040)
N CNT,DATA,DATE,DFN,HLOC,IEN,LOCLIST,OK,WARD,WARDP
K ^TMP($J,PLIST),^TMP($J,"CNT")
S DATE=BDT-.000001
S OK=1
S LOCLIST=$S(PARAM'="":+$O(^PXRMD(810.9,"B",PARAM,0)),1:0)
F S DATE=$O(^DGPM(SUB,DATE)) Q:(DATE>EDT)!(DATE="") D
. S IEN=""
. F S IEN=$O(^DGPM(SUB,DATE,IEN)) Q:IEN="" D
.. S DATA=^DGPM(IEN,0)
.. S DFN=$P(DATA,U,3)
.. I SUB="ATT1" D
...;WARD is a required field but it may not exist for older entries.
... S WARDP=+$P(DATA,U,6)
... S WARD=WARDP_";"_$S(WARDP>0:$P($G(^DIC(42,WARDP,0)),U,1),1:0)
.. I SUB="ATT3" D
... S WARD=$$GET1^DIQ(405,IEN,200)
... S WARDP=$S(WARD'="":$O(^DIC(42,"B",WARD,"")),1:0)
... S WARD=WARDP_";"_WARD
..;If a location list has been passed in make sure the hospital
..;location for the ward is on the list.
.. S HLOC=$S(WARDP>0:^DIC(42,WARDP,44),1:0)
.. I LOCLIST>0 S OK=$S($D(^PXRMD(810.9,LOCLIST,44,"B",HLOC)):1,1:0)
.. I 'OK Q
.. S (CNT,^TMP($J,"CNT",DFN))=+$G(^TMP($J,"CNT",DFN))+1
.. S ^TMP($J,PLIST,DFN,CNT)=U_DATE_U_405_U_DFN_U_WARD
.. S INST=$S(HLOC>0:+$P(^SC(HLOC,0),U,4),1:0)
.. S INSTNM=INST_";"_$S(INST>0:$P(^DIC(4,INST,0),U,1),1:0)
.. S INSTNM=INSTNM_";"_$S(INST>0:$P($G(^DIC(4,INST,99)),U,1),1:0)
.. S ^TMP($J,PLIST,DFN,CNT,"VALUE")=WARD
.. S ^TMP($J,PLIST,DFN,CNT,"INSTITUTION")=INSTNM
.. S ^TMP($J,PLIST,DFN,CNT,"TYPE_OF_MVMT")=$$GET1^DIQ(405.1,$P(DATA,U,4),.01)
K ^TMP($J,"CNT")
Q
;
;=====================================
CURR(NGET,BDT,EDT,PLIST,PARAM) ;Current inpatients.
; DBIAs #10035, #10039, #10040, #10061, #10090
N CNT,DFN,HLOC,INST,INSTNM,LOCLIST,OK,WARD,WARDP,WARDSUB,VAIN,VAERR
K ^TMP($J,PLIST),^TMP($J,"CNT")
S OK=1
S LOCLIST=$S(PARAM'="":+$O(^PXRMD(810.9,"B",PARAM,0)),1:0)
S WARD=""
F S WARD=$O(^DPT("CN",WARD)) Q:WARD="" D
. S DFN=0
. F S DFN=$O(^DPT("CN",WARD,DFN)) Q:'+DFN D
..;If a location list has been passed in make sure the hospital
..;location for the ward is on the list.
.. S WARDP=+$O(^DIC(42,"B",WARD,""))
.. S HLOC=+$G(^DIC(42,WARDP,44))
.. I LOCLIST>0 S OK=$S($D(^PXRMD(810.9,LOCLIST,44,"B",HLOC)):1,1:0)
.. I 'OK Q
.. K VAIN,VAERR D INP^VADPT
.. S WARDSUB=+VAIN(4)_";"_WARD
.. S (CNT,^TMP($J,"CNT",DFN))=+$G(^TMP($J,"CNT",DFN))+1
.. S ^TMP($J,PLIST,DFN,CNT)=U_+VAIN(7)_U_2_U_DFN_U_WARDSUB
.. S INST=$S(HLOC>0:+$P(^SC(HLOC,0),U,4),1:0)
.. S INSTNM=INST_";"_$S(INST>0:$P(^DIC(4,INST,0),U,1),1:0)
.. S INSTNM=INSTNM_";"_$S(INST>0:$P($G(^DIC(4,INST,99)),U,1),1:0)
.. S ^TMP($J,PLIST,DFN,CNT,"VALUE")=WARDSUB
.. S ^TMP($J,PLIST,DFN,CNT,"INSTITUTION")=INSTNM
.. S ^TMP($J,PLIST,DFN,CNT,"ADMIT DATE")=VAIN(7)
K ^TMP($J,"CNT")
Q
;
;=====================================
DISCH(NGET,BDT,EDT,PLIST,PARAM) ;Discharges during a date range.
;NOTE: ASIH is not accounted for in this version.
D ADMDISCH(BDT,EDT,PLIST,PARAM,"ATT3")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMINPL 3416 printed Dec 13, 2024@01:46:13 Page 2
PXRMINPL ;SLC/RMS,PKR - List computed findings for inpatient info. ; 09/08/2008
+1 ;;2.0;CLINICAL REMINDERS;**12**;Feb 04, 2005;Build 73
+2 ;=====================================
ADM(NGET,BDT,EDT,PLIST,PARAM) ;All admissions during a date range.
+1 DO ADMDISCH(BDT,EDT,PLIST,PARAM,"ATT1")
+2 QUIT
+3 ;
+4 ;=====================================
ADMDISCH(BDT,EDT,PLIST,PARAM,SUB) ;Build admission and discharge lists.
+1 ;Admissions when SUB="ATT1" and discharges when SUB="ATT3"
+2 ;DBIAs (^DIC(4: #2251,#10090), (^DIC(42: #10039),
+3 ;(^DGPM: #1480), (^DPT: #187), (^SC: #10040)
+4 NEW CNT,DATA,DATE,DFN,HLOC,IEN,LOCLIST,OK,WARD,WARDP
+5 KILL ^TMP($JOB,PLIST),^TMP($JOB,"CNT")
+6 SET DATE=BDT-.000001
+7 SET OK=1
+8 SET LOCLIST=$SELECT(PARAM'="":+$ORDER(^PXRMD(810.9,"B",PARAM,0)),1:0)
+9 FOR
SET DATE=$ORDER(^DGPM(SUB,DATE))
if (DATE>EDT)!(DATE="")
QUIT
Begin DoDot:1
+10 SET IEN=""
+11 FOR
SET IEN=$ORDER(^DGPM(SUB,DATE,IEN))
if IEN=""
QUIT
Begin DoDot:2
+12 SET DATA=^DGPM(IEN,0)
+13 SET DFN=$PIECE(DATA,U,3)
+14 IF SUB="ATT1"
Begin DoDot:3
+15 ;WARD is a required field but it may not exist for older entries.
+16 SET WARDP=+$PIECE(DATA,U,6)
+17 SET WARD=WARDP_";"_$SELECT(WARDP>0:$PIECE($GET(^DIC(42,WARDP,0)),U,1),1:0)
End DoDot:3
+18 IF SUB="ATT3"
Begin DoDot:3
+19 SET WARD=$$GET1^DIQ(405,IEN,200)
+20 SET WARDP=$SELECT(WARD'="":$ORDER(^DIC(42,"B",WARD,"")),1:0)
+21 SET WARD=WARDP_";"_WARD
End DoDot:3
+22 ;If a location list has been passed in make sure the hospital
+23 ;location for the ward is on the list.
+24 SET HLOC=$SELECT(WARDP>0:^DIC(42,WARDP,44),1:0)
+25 IF LOCLIST>0
SET OK=$SELECT($DATA(^PXRMD(810.9,LOCLIST,44,"B",HLOC)):1,1:0)
+26 IF 'OK
QUIT
+27 SET (CNT,^TMP($JOB,"CNT",DFN))=+$GET(^TMP($JOB,"CNT",DFN))+1
+28 SET ^TMP($JOB,PLIST,DFN,CNT)=U_DATE_U_405_U_DFN_U_WARD
+29 SET INST=$SELECT(HLOC>0:+$PIECE(^SC(HLOC,0),U,4),1:0)
+30 SET INSTNM=INST_";"_$SELECT(INST>0:$PIECE(^DIC(4,INST,0),U,1),1:0)
+31 SET INSTNM=INSTNM_";"_$SELECT(INST>0:$PIECE($GET(^DIC(4,INST,99)),U,1),1:0)
+32 SET ^TMP($JOB,PLIST,DFN,CNT,"VALUE")=WARD
+33 SET ^TMP($JOB,PLIST,DFN,CNT,"INSTITUTION")=INSTNM
+34 SET ^TMP($JOB,PLIST,DFN,CNT,"TYPE_OF_MVMT")=$$GET1^DIQ(405.1,$PIECE(DATA,U,4),.01)
End DoDot:2
End DoDot:1
+35 KILL ^TMP($JOB,"CNT")
+36 QUIT
+37 ;
+38 ;=====================================
CURR(NGET,BDT,EDT,PLIST,PARAM) ;Current inpatients.
+1 ; DBIAs #10035, #10039, #10040, #10061, #10090
+2 NEW CNT,DFN,HLOC,INST,INSTNM,LOCLIST,OK,WARD,WARDP,WARDSUB,VAIN,VAERR
+3 KILL ^TMP($JOB,PLIST),^TMP($JOB,"CNT")
+4 SET OK=1
+5 SET LOCLIST=$SELECT(PARAM'="":+$ORDER(^PXRMD(810.9,"B",PARAM,0)),1:0)
+6 SET WARD=""
+7 FOR
SET WARD=$ORDER(^DPT("CN",WARD))
if WARD=""
QUIT
Begin DoDot:1
+8 SET DFN=0
+9 FOR
SET DFN=$ORDER(^DPT("CN",WARD,DFN))
if '+DFN
QUIT
Begin DoDot:2
+10 ;If a location list has been passed in make sure the hospital
+11 ;location for the ward is on the list.
+12 SET WARDP=+$ORDER(^DIC(42,"B",WARD,""))
+13 SET HLOC=+$GET(^DIC(42,WARDP,44))
+14 IF LOCLIST>0
SET OK=$SELECT($DATA(^PXRMD(810.9,LOCLIST,44,"B",HLOC)):1,1:0)
+15 IF 'OK
QUIT
+16 KILL VAIN,VAERR
DO INP^VADPT
+17 SET WARDSUB=+VAIN(4)_";"_WARD
+18 SET (CNT,^TMP($JOB,"CNT",DFN))=+$GET(^TMP($JOB,"CNT",DFN))+1
+19 SET ^TMP($JOB,PLIST,DFN,CNT)=U_+VAIN(7)_U_2_U_DFN_U_WARDSUB
+20 SET INST=$SELECT(HLOC>0:+$PIECE(^SC(HLOC,0),U,4),1:0)
+21 SET INSTNM=INST_";"_$SELECT(INST>0:$PIECE(^DIC(4,INST,0),U,1),1:0)
+22 SET INSTNM=INSTNM_";"_$SELECT(INST>0:$PIECE($GET(^DIC(4,INST,99)),U,1),1:0)
+23 SET ^TMP($JOB,PLIST,DFN,CNT,"VALUE")=WARDSUB
+24 SET ^TMP($JOB,PLIST,DFN,CNT,"INSTITUTION")=INSTNM
+25 SET ^TMP($JOB,PLIST,DFN,CNT,"ADMIT DATE")=VAIN(7)
End DoDot:2
End DoDot:1
+26 KILL ^TMP($JOB,"CNT")
+27 QUIT
+28 ;
+29 ;=====================================
DISCH(NGET,BDT,EDT,PLIST,PARAM) ;Discharges during a date range.
+1 ;NOTE: ASIH is not accounted for in this version.
+2 DO ADMDISCH(BDT,EDT,PLIST,PARAM,"ATT3")
+3 QUIT
+4 ;
