Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BQIDCINP

BQIDCINP.m

Go to the documentation of this file. 
  1. BQIDCINP ;GDIT/HS/ALA-Find Inpatient Patients ; 06 Nov 2012  3:43 PM
  1.  ;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
  1.  ;
  1.  Q
  1.  ;
  1. EN(DATA,PARMS,MPARMS) ;EP
  1.  ;
  1.  ;Description
  1.  ;  Executable to retrieve inpatients for the specified parameters
  1.  ;Input
  1.  ;  PARMS = Array of parameters and their values
  1.  ;  MPARMS = Multiple array of a parameter
  1.  ;Output
  1.  ;  ^TMP("BQIDCINP",UID,DFN,VISIT IEN)=""
  1.  ;
  1.  NEW UID,AFDT,AEDT,DFDT,DEDT,NXN,IEN,CURINP,ARANGE,DRANGE,RFROM,RTHRU,AFROM,ATHRU
  1.  NEW DFROM,DTHRU,LOC,IEN,DFN,NXN,VIEN,VISIT,ATYP,APROV,WARD,DTYP,FTSPEC,CT,MCT
  1.  NEW DSDTM,ADTM,NRSE,NURSE
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIDCINP",UID))
  1.  S DCRIT=$NA(^TMP("BQICRIT",UID))
  1.  K @DATA,@DCRIT
  1.  ;
  1.  ;  Set the parameters into variables
  1.  I '$D(PARMS) Q
  1.  ;
  1.  S NM="" F  S NM=$O(PARMS(NM)) Q:NM=""  S @NM=PARMS(NM)
  1.  S CURINP=$G(CURINP,""),ARANGE=$G(ARANGE,""),AFROM=$G(AFROM,""),ATHRU=$G(ATHRU,""),ATYP=$G(ATYP,"")
  1.  S DRANGE=$G(DRANGE,""),DFROM=$G(DFROM,""),DTHRU=$G(DTHRU,""),DTYP=$G(DTYP,""),APROV=$G(APROV,"")
  1.  S WARD=$G(WARD,""),FTSPEC=$G(FTSPEC,"")
  1.  ;
  1.  I $G(ARANGE)'="" D
  1.  . I $G(PPIEN)'="" D RANGE^BQIDCAH1(ARANGE,PPIEN,"ARANGE")
  1.  . S AFDT=$S($G(RFROM)'="":RFROM,1:$G(AFROM))
  1.  . S AEDT=$S($G(RTHRU)'="":RTHRU,1:$G(ATHRU))
  1.  I $G(AFROM)'="" S AFDT=AFROM,AEDT=$G(ATHRU)
  1.  ;
  1.  I $G(DRANGE)'="" D
  1.  . I $G(PPIEN)'="" D RANGE^BQIDCAH1(DRANGE,PPIEN,"DRANGE")
  1.  . S DFDT=$S($G(RFROM)'="":RFROM,1:$G(DFROM))
  1.  . S DEDT=$S($G(RTHRU)'="":RTHRU,1:$G(DTHRU))
  1.  I $G(DFROM)'="" S DFDT=DFROM,DEDT=$G(DTHRU)
  1.  ;
  1.  I $G(CURINP)'="" D
  1.  . S LOC=""
  1.  . F  S LOC=$O(^DGPM("CN",LOC)) Q:LOC=""  D
  1.  .. S IEN=""
  1.  .. F  S IEN=$O(^DGPM("CN",LOC,IEN)) Q:IEN=""  D
  1.  ... I $G(^DGPM(IEN,0))="" Q
  1.  ... S DFN=$P(^DGPM(IEN,0),U,3),$P(@DCRIT@("INP",DFN,IEN),U,1)=1
  1.  ... S ADTM=$P(^DGPM(IEN,0),U,1)\1
  1.  ... I $G(AFDT)'="",ADTM<AFDT!(ADTM>AEDT) S $P(@DCRIT@("INP",DFN,IEN),U,1)=0 Q
  1.  ... D ADM
  1.  ;
  1.  I $G(CURINP)="",$G(AFDT)'="" D
  1.  . S AFDT=AFDT-.0001
  1.  . F  S AFDT=$O(^DGPM("B",AFDT)) Q:AFDT=""!(AFDT\1>AEDT)  D
  1.  .. S IEN=""
  1.  .. F  S IEN=$O(^DGPM("B",AFDT,IEN)) Q:IEN=""  D
  1.  ... I $$GET1^DIQ(405,IEN_",",.02,"E")'="ADMISSION" Q
  1.  ... I $G(^DGPM(IEN,0))="" Q
  1.  ... S DFN=$P(^DGPM(IEN,0),U,3),$P(@DCRIT@("INP",DFN,IEN),U,1)=1
  1.  ... D ADM
  1.  ;
  1.  I $G(DFDT)'="" D
  1.  . I $D(@DCRIT) D
  1.  .. S DFN=""
  1.  .. F  S DFN=$O(@DCRIT@("INP",DFN)) Q:DFN=""  D
  1.  ... S IEN=""
  1.  ... F  S IEN=$O(@DCRIT@("INP",DFN,IEN)) Q:IEN=""  D
  1.  .... S NXN="",QFL=0
  1.  .... F  S NXN=$O(^DGPM("CA",IEN,NXN),-1)  Q:NXN=IEN  D  Q:QFL
  1.  ..... I $$GET1^DIQ(405,NXN_",",.02,"E")'="DISCHARGE" S $P(@DCRIT@("INP",DFN,IEN),U,6)=0 Q
  1.  ..... D:$G(DTYP)="" UPD(7,"") D:$G(DTYP)'="" UPD(7,0)
  1.  ..... I $G(DTYP)'="",$P(^DGPM(IEN,0),U,4)=DTYP D UPD(7,1)
  1.  ..... S DSDTM=$$GET1^DIQ(405,NXN_",",.01,"I")
  1.  ..... I DSDTM\1<DFDT!(DSDTM\1>DEDT) S $P(@DCRIT@("INP",DFN,IEN),U,6)=0 Q
  1.  ..... S $P(@DCRIT@("INP",DFN,IEN),U,6)=1,QFL=1
  1.  ..... ;D CNF
  1.  . I '$D(@DCRIT) D
  1.  .. S DFDT=DFDT-.0001
  1.  .. F  S DFDT=$O(^AUPNVINP("B",DFDT)) Q:DFDT=""!(DFDT\1>DEDT)  D
  1.  ... S VIEN=""
  1.  ... F  S VIEN=$O(^AUPNVINP("B",DFDT,VIEN)) Q:VIEN=""  D
  1.  .... I $G(^AUPNVINP(VIEN,0))="" Q
  1.  .... S VISIT=$P(^AUPNVINP(VIEN,0),U,3),DFN=$P(^(0),U,2)
  1.  .... S IEN=$O(^DGPM("AVISIT",VISIT,"")) I IEN="" Q
  1.  .... S DFN=$P(^DGPM(IEN,0),U,3),$P(@DCRIT@("INP",DFN,IEN),U,6)=1
  1.  .... D ADM,DIS
  1.  ;
  1.  S DFN=""
  1.  F  S DFN=$O(@DCRIT@("INP",DFN)) Q:DFN=""  D
  1.  . S IEN=""
  1.  . F  S IEN=$O(@DCRIT@("INP",DFN,IEN)) Q:IEN=""  D CNF
  1.  ;
  1.  Q
  1.  ;
  1. UPD(PEC,VAL) ;EP
  1.  S $P(@DCRIT@("INP",DFN,IEN),U,PEC)=VAL
  1.  Q
  1.  ;
  1. DIS ; EP - Discharge
  1.  S NXN=""
  1.  F  S NXN=$O(^DGPM("CA",IEN,NXN),-1)  Q:NXN=IEN  D
  1.  . I $$GET1^DIQ(405,NXN_",",.02,"E")'="DISCHARGE" Q
  1.  . S DFN=$P(^DGPM(IEN,0),U,3),$P(@DCRIT@("INP",DFN,IEN),U,6)=1
  1.  . I $G(DTYP)="",'$D(MPARMS("DTYP")) D UPD(7,"")
  1.  . I $G(DTYP)'="" D UPD(7,0) I $P(^DGPM(IEN,0),U,4)=DTYP D UPD(7,1)
  1.  . I $G(DTYP)="",$D(MPARMS("DTYP")) D
  1.  .. S DTYP="" D UPD(7,"")
  1.  .. F  S DTYP=$O(MPARMS("DTYP",DTYP)) Q:DTYP=""  I $P(^DGPM(IEN,0),U,4)=DTYP D UPD(7,1)
  1.  . S VISIT=$P(^DGPM(IEN,0),U,27) I VISIT="" Q
  1.  . I $G(NURSE)="",'$D(MPARMS("NURSE")) D UPD(8,"")
  1.  . S TIEN=""
  1.  . F  S TIEN=$O(^TIU(8925,"V",VISIT,TIEN)) Q:TIEN=""  D
  1.  .. I $$GET1^DIQ(8925,TIEN_",",.01,"E")'["NURSE" Q
  1.  .. S NRSE=$$GET1^DIQ(8925,TIEN_",",1202,"I") I NRSE="" Q
  1.  .. I $G(NURSE)'="" D UPD(8,0) I NURSE=NRSE D UPD(8,1) Q
  1.  .. I $G(NURSE)="",$D(MPARMS("NURSE")) D UPD(8,0) I $D(MPARMS("NURSE",NRSE)) D UPD(8,1)
  1.  Q
  1.  ;
  1. CNF ;EP - confirm
  1.  S CT=0,MCT=0
  1.  F I=1:1:$L(@DCRIT@("INP",DFN,IEN),U) D
  1.  . I $P(@DCRIT@("INP",DFN,IEN),U,I)'="" S CT=CT+1
  1.  . I $P(@DCRIT@("INP",DFN,IEN),U,I)'="",$P(@DCRIT@("INP",DFN,IEN),U,I)=1 S MCT=MCT+1
  1.  I CT=0 K @DCRIT@("INP",DFN,IEN) Q
  1.  I CT'=MCT K @DCRIT@("INP",DFN,IEN) Q
  1.  I CT=MCT S @DATA@(DFN)=""
  1.  Q
  1.  ;
  1. ADM ;EP - Admission
  1.  I $G(ATYP)="",'$D(MPARMS("ATYP")) D UPD(2,"")
  1.  I $G(ATYP)'="" D UPD(2,0) I $P(^DGPM(IEN,0),U,4)=ATYP D UPD(2,1)
  1.  I $G(ATYP)="",$D(MPARMS("ATYP")) D
  1.  . S ATYP="" D UPD(2,0)
  1.  . F  S ATYP=$O(MPARMS("ATYP",ATYP)) Q:ATYP=""  I $P(^DGPM(IEN,0),U,4)=ATYP D UPD(2,1)
  1.  I $G(WARD)="",'$D(MPARMS("WARD")) D UPD(3,"")
  1.  I $G(WARD)'="" D UPD(3,0) I $P(^DGPM(IEN,0),U,6)=WARD D UPD(3,1)
  1.  I $G(WARD)="",$D(MPARMS("WARD")) D
  1.  . S WARD="" D UPD(3,0)
  1.  . F  S WARD=$O(MPARMS("WARD",WARD)) Q:WARD=""  I $P(^DGPM(IEN,0),U,6)=WARD D UPD(3,1)
  1.  S NXN=$O(^DGPM("CA",IEN,IEN)) I NXN="" Q
  1.  I $G(APROV)="",'$D(MPARMS("APROV")) D UPD(4,"")
  1.  I $G(APROV)'="" D UPD(4,0) I $P(^DGPM(NXN,0),U,19)=APROV D UPD(4,1)
  1.  I $G(APROV)="",$D(MPARMS("APROV")) D
  1.  . S APROV="" D UPD(4,0)
  1.  . F  S APROV=$O(MPARMS("APROV",APROV)) Q:APROV=""  I $P(^DGPM(NXN,0),U,19)=APROV D UPD(4,1)
  1.  I $G(FTSPEC)="",'$D(MPARMS("FTSPEC")) D UPD(5,"")
  1.  I $G(FTSPEC)'="" D UPD(5,0) I $P(^DGPM(NXN,0),U,9)=FTSPEC D UPD(5,1)
  1.  I $G(FTSPEC)'="",$D(MPARMS("FTSPEC")) D
  1.  . S FTSPEC="" D UPD(5,0)
  1.  . F  S FTSPEC=$O(MPARMS("FTSPEC",FTSPEC)) Q:FTSPEC=""  I $P(^DGPM(NXN,0),U,9)=FTSPEC D UPD(5,1)
  1.  Q