- 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
- ;
- 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 ;
