BQIDCAH4 ;GDIT/HS/ALA-Ad Hoc continued ; 10 Dec 2012 3:23 PM
;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
;
PROB(FGLOB,TGLOB,PROB,PROBTX,FDT,TDT,MPARMS) ;EP - Problems
NEW PRPT,CT,IEN,PB,PCT,PTAX,TREF
I $G(PROBTX)'="" D
. S TREF=$NA(MPARMS("PROB"))
. K @TREF
. S PTAX=$P(@("^"_$P(PROBTX,";",2)_$P(PROBTX,";",1)_",0)"),"^",1)
. D BLD^BQITUTL(PTAX,TREF)
;
I PROP="!" D
. I $D(MPARMS("PROB")) S PROB="" F S PROB=$O(MPARMS("PROB",PROB)) Q:PROB="" D PRBB
. I '$D(MPARMS("PROB")) D PRBB
I PROP="&" D
. K PRPT
. S PROB="",CT=0 F S PROB=$O(MPARMS("PROB",PROB)) Q:PROB="" D PRBB S CT=CT+1
. S IEN=""
. F S IEN=$O(PRPT(IEN)) Q:IEN="" D
.. S PCT=0,PB=""
.. F S PB=$O(PRPT(IEN,PB)) Q:PB="" S PCT=PCT+1
.. I PCT=CT S @TGLOB@(IEN)="" D Q
... F S PB=$O(PRPT(IEN,PB)) Q:PB="" S PIEN=PRPT(IEN,PB),@CRIT@("PROB",IEN,PIEN)=""
;
Q
;
PRBB ; Problem
NEW DFN,IEN
S TDT=$S(TDT'="":TDT,1:DT)
; If 'from' data global is populated, use those entries to filter by
I $G(FGLOB)'="" D Q
. NEW IEN,PIEN,PB,STAT,VSDTM
. S IEN=""
. F S IEN=$O(@FGLOB@(IEN)) Q:'IEN D
.. I $O(^AUPNPROB("AC",IEN,""))="" Q
.. S PIEN=""
.. F S PIEN=$O(^AUPNPROB("AC",IEN,PIEN)) Q:PIEN="" D
... S PB=$P(^AUPNPROB(PIEN,0),U,1)
... I $D(MPARMS("PROB")),'$D(MPARMS("PROB",PB)) Q
... I '$D(MPARMS("PROB")),PB'=PROB Q
... S STAT=$P(^AUPNPROB(PIEN,0),U,12)
... I PRSTAT'="",STAT'=PRSTAT Q
... I $D(MPARMS("PRSTAT")),'$D(MPARMS("PRSTAT",STAT)) Q
... S VSDTM=$$PROB^BQIUL1(PIEN)
... I FDT'="",VSDTM<FDT!(VSDTM>TDT) Q
... I PROP="!" S @TGLOB@(IEN)="",@CRIT@("PROB",IEN,PIEN)="" Q
... I PROP="&" S PRPT(IEN,PROB)=PIEN
;
; if no additional entries to filter by, build list by problem only to filter on
NEW IEN,DFN,VSDTM,STAT
S IEN=""
F S IEN=$O(^AUPNPROB("B",PROB,IEN)) Q:IEN="" D
. S DFN=$P($G(^AUPNPROB(IEN,0)),U,2)
. S VSDTM=$$PROB^BQIUL1(IEN)
. I FDT'="",VSDTM<FDT!(VSDTM>TDT) Q
. S STAT=$P(^AUPNPROB(IEN,0),U,12)
. I PRSTAT'="",STAT'=PRSTAT Q
. I $D(MPARMS("PRSTAT")),'$D(MPARMS("PRSTAT",STAT)) Q
. I DFN'="",PROP="!" S @TGLOB@(DFN)="",@CRIT@("PROB",DFN,IEN)="" Q
. I DFN'="",PROP="&" S PRPT(DFN,PROB)=IEN
;
Q
;
NRV(FGLOB,TGLOB,FDT,TDT) ;EP - problems not reviewed
NEW DFN,BGT,EDT,OK
I $G(FGLOB)="" D
. S DFN=0
. F S DFN=$O(^AUPNPAT(DFN)) Q:'DFN D
.. I $G(^AUPNPAT(DFN,0))="" Q
.. I '$D(^AUPNVRUP("AA",DFN,1)) S @TGLOB@(DFN)="" Q
.. S OK=0
.. I FDT'="" D Q
... S BGT=(9999999-TDT)-.0001,EDT=9999999-FDT
... F S BGT=$O(^AUPNVRUP("AA",DFN,1,BGT)) Q:BGT=""!(BGT\1>EDT) S OK=1
.. I 'OK S @TGLOB@(DFN)=""
;
I $G(FGLOB)'="" D
. S DFN=""
. F S DFN=$O(@FGLOB@(DFN)) Q:DFN="" D
.. I '$D(^AUPNVRUP("AA",DFN,1)) S @TGLOB@(DFN)="" Q
.. S OK=0
.. I FDT'="" D
... S BGT=(9999999-TDT)-.0001,EDT=9999999-FDT
... F S BGT=$O(^AUPNVRUP("AA",DFN,1,BGT)) Q:BGT=""!(BGT\1>EDT) S OK=1
.. I 'OK S @TGLOB@(DFN)=""
Q
;
VCHK ;EP
I '$D(^AUPNVRUP("AC",DFN)) S @TGLOB@(DFN)="" Q
I '$D(^AUPNVRUP("AA",DFN,1)) S @TGLOB@(DFN)=""
Q
;
NAC(FGLOB,TGLOB,FDT,TDT) ;EP - No active problems
NEW DFN
I $G(FGLOB)="" D
. S DFN=0
. F S DFN=$O(^AUPNPAT(DFN)) Q:'DFN D
.. I $G(^AUPNPAT(DFN,0))="" Q
.. I $D(^AUPNVRUP("AA",DFN,3)) D
... I FDT'="" D Q
.... S BGT=(9999999-TDT)-.0001,EDT=9999999-FDT
.... F S BGT=$O(^AUPNVRUP("AA",DFN,3,BGT)) Q:BGT=""!(BGT\1>EDT) S @TGLOB@(DFN)=""
... S @TGLOB@(DFN)=""
;
I $G(FGLOB)'="" D
. S DFN=""
. F S DFN=$O(@FGLOB@(DFN)) Q:DFN="" D
.. I $D(^AUPNVRUP("AA",DFN,3)) D
... I FDT'="" D Q
.... S BGT=(9999999-TDT)-.0001,EDT=9999999-FDT
.... F S BGT=$O(^AUPNVRUP("AA",DFN,3,BGT)) Q:BGT=""!(BGT\1>EDT) S @TGLOB@(DFN)=""
... S @TGLOB@(DFN)=""
Q
;
NDC(FGLOB,TGLOB) ;EP - No documented problems
NEW DFN
I $G(FGLOB)="" D
. S DFN=0
. F S DFN=$O(^AUPNPAT(DFN)) Q:'DFN D
.. I $G(^AUPNPAT(DFN,0))="" Q
.. I '$D(^AUPNPROB("AC",DFN)) S @TGLOB@(DFN)=""
I $G(FGLOB)'="" D
. S DFN=""
. F S DFN=$O(@FGLOB@(DFN)) Q:DFN="" D
.. I '$D(^AUPNPROB("AC",DFN)) S @TGLOB@(DFN)=""
Q
;
MND(FGLOB,TGLOB) ;EP - No documented medications
NEW DFN
I $G(FGLOB)="" D
. S DFN=0
. F S DFN=$O(^AUPNPAT(DFN)) Q:'DFN D
.. I $G(^AUPNPAT(DFN,0))="" Q
.. I '$D(^AUPNVMED("AC",DFN)) S @TGLOB@(DFN)=""
I $G(FGLOB)'="" D
. S DFN=""
. F S DFN=$O(@FGLOB@(DFN)) Q:DFN="" D
.. I '$D(^AUPNVMED("AC",DFN)) S @TGLOB@(DFN)=""
Q
;
NAM(FGLOB,TGLOB,FDT,TDT) ;EP - no active medications
NEW DFN
I $G(FGLOB)="" D
. S DFN=0
. F S DFN=$O(^AUPNPAT(DFN)) Q:'DFN D
.. I $G(^AUPNPAT(DFN,0))="" Q
.. I $D(^AUPNVRUP("AA",DFN,7)) D
... I FDT'="" D Q
.... S BGT=(9999999-TDT)-.0001,EDT=9999999-FDT
.... F S BGT=$O(^AUPNVRUP("AA",DFN,7,BGT)) Q:BGT=""!(BGT\1>EDT) S @TGLOB@(DFN)=""
... S @TGLOB@(DFN)=""
;
I $G(FGLOB)'="" D
. S DFN=""
. F S DFN=$O(@FGLOB@(DFN)) Q:DFN="" D
.. I $D(^AUPNVRUP("AA",DFN,7)) D
... I FDT'="" D Q
.... S BGT=(9999999-TDT)-.0001,EDT=9999999-FDT
.... F S BGT=$O(^AUPNVRUP("AA",DFN,7,BGT)) Q:BGT=""!(BGT\1>EDT) S @TGLOB@(DFN)=""
... S @TGLOB@(DFN)=""
Q
;
MLR(FGLOB,TGLOB,FDT,TDT) ;EP - medications not reviewed
NEW DFN,BGT,EDT,OK
I $G(FGLOB)="" D
. S DFN=0
. F S DFN=$O(^AUPNPAT(DFN)) Q:'DFN D
.. I $G(^AUPNPAT(DFN,0))="" Q
.. I '$D(^AUPNVRUP("AA",DFN,5)) S @TGLOB@(DFN)="" Q
.. S OK=0
.. I FDT'="" D Q
... S BGT=(9999999-TDT)-.0001,EDT=9999999-FDT
... F S BGT=$O(^AUPNVRUP("AA",DFN,5,BGT)) Q:BGT=""!(BGT\1>EDT) S OK=1
.. I 'OK S @TGLOB@(DFN)=""
;
I $G(FGLOB)'="" D
. S DFN=""
. F S DFN=$O(@FGLOB@(DFN)) Q:DFN="" D
.. I '$D(^AUPNVRUP("AA",DFN,5)) S @TGLOB@(DFN)="" Q
.. S OK=0
.. I FDT'="" D
... S BGT=(9999999-TDT)-.0001,EDT=9999999-FDT
... F S BGT=$O(^AUPNVRUP("AA",DFN,5,BGT)) Q:BGT=""!(BGT\1>EDT) S OK=1
.. I 'OK S @TGLOB@(DFN)=""
Q
;
EMP(FGLOB,TGLOB,EMPL,MPARMS) ;EP - Employer search
I $G(TGLOB)="" Q
I $G(EMPL)'="" D
. S EMPL=""
. F S EMPL=$O(^BQI(90508,1,18,"B",EMPL)) Q:EMPL="" D EMD
Q
;
EMD ;EP
NEW IEN,DFN
I $G(FGLOB)'="" D
. S IEN=""
. F S IEN=$O(@FGLOB@(IEN)) Q:'IEN I $P($G(^AUPNPAT(IEN,0)),U,19)=EMPL S @TGLOB@(IEN)=""
;
I $G(FGLOB)="" D
. S DFN=""
. F S DFN=$O(^AUPNPAT("AF",EMPL,DFN)) Q:DFN="" S @TGLOB@(DFN)=""
Q
;
PNL(FGLOB,TGLOB,PLIDEN,MPARMS) ;EP - Panel search
I $G(TGLOB)="" Q
I PLIDEN]"" D PLD
I $D(MPARMS("PLIDEN")) S PLIDEN="" F S PLIDEN=$O(MPARMS("PLIDEN",PLIDEN)) Q:PLIDEN="" D PLD
Q
;
PLD ;EP
NEW OWNR,PLNME,DA,IENS,PLIEN
S OWNR=$P(PLIDEN,$C(26),1),PLNME=$P(PLIDEN,$C(26),2)
S DA="",DA(1)=OWNR,IENS=$$IENS^DILF(.DA)
S PLIEN=$$FIND1^DIC(90505.01,IENS,"X",PLNME,"","","ERROR")
I PLIEN="" Q
I $G(FGLOB)'="" D
. S IEN=""
. F S IEN=$O(@FGLOB@(IEN)) Q:'IEN D
.. I $D(^BQICARE(OWNR,1,PLIEN,40,IEN)),$P(^BQICARE(OWNR,1,PLIEN,40,IEN,0),U,2)'="R" S @TGLOB@(IEN)=""
;
NEW DFN,IEN
I $G(FGLOB)="" D
. S DFN=0
. F S DFN=$O(^BQICARE(OWNR,1,PLIEN,40,DFN)) Q:'DFN D
.. I $P(^BQICARE(OWNR,1,PLIEN,40,DFN,0),U,2)="R" Q
.. S @TGLOB@(DFN)=""
Q
BQIDCAH4 ;GDIT/HS/ALA-Ad Hoc continued ; 10 Dec 2012 3:23 PM
+1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
+2 ;
PROB(FGLOB,TGLOB,PROB,PROBTX,FDT,TDT,MPARMS) ;EP - Problems
+1 NEW PRPT,CT,IEN,PB,PCT,PTAX,TREF
+2 IF $GET(PROBTX)'=""
Begin DoDot:1
+3 SET TREF=$NAME(MPARMS("PROB"))
+4 KILL @TREF
+5 SET PTAX=$PIECE(@("^"_$PIECE(PROBTX,";",2)_$PIECE(PROBTX,";",1)_",0)"),"^",1)
+6 DO BLD^BQITUTL(PTAX,TREF)
End DoDot:1
+7 ;
+8 IF PROP="!"
Begin DoDot:1
+9 IF $DATA(MPARMS("PROB"))
SET PROB=""
FOR
SET PROB=$ORDER(MPARMS("PROB",PROB))
IF PROB=""
QUIT
DO PRBB
+10 IF '$DATA(MPARMS("PROB"))
DO PRBB
End DoDot:1
+11 IF PROP="&"
Begin DoDot:1
+12 KILL PRPT
+13 SET PROB=""
SET CT=0
FOR
SET PROB=$ORDER(MPARMS("PROB",PROB))
IF PROB=""
QUIT
DO PRBB
SET CT=CT+1
+14 SET IEN=""
+15 FOR
SET IEN=$ORDER(PRPT(IEN))
IF IEN=""
QUIT
Begin DoDot:2
+16 SET PCT=0
SET PB=""
+17 FOR
SET PB=$ORDER(PRPT(IEN,PB))
IF PB=""
QUIT
SET PCT=PCT+1
+18 IF PCT=CT
SET @TGLOB@(IEN)=""
Begin DoDot:3
+19 FOR
SET PB=$ORDER(PRPT(IEN,PB))
IF PB=""
QUIT
SET PIEN=PRPT(IEN,PB)
SET @CRIT@("PROB",IEN,PIEN)=""
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+20 ;
+21 QUIT
+22 ;
PRBB ; Problem
+1 NEW DFN,IEN
+2 SET TDT=$SELECT(TDT'="":TDT,1:DT)
+3 ; If 'from' data global is populated, use those entries to filter by
+4 IF $GET(FGLOB)'=""
Begin DoDot:1
+5 NEW IEN,PIEN,PB,STAT,VSDTM
+6 SET IEN=""
+7 FOR
SET IEN=$ORDER(@FGLOB@(IEN))
IF 'IEN
QUIT
Begin DoDot:2
+8 IF $ORDER(^AUPNPROB("AC",IEN,""))=""
QUIT
+9 SET PIEN=""
+10 FOR
SET PIEN=$ORDER(^AUPNPROB("AC",IEN,PIEN))
IF PIEN=""
QUIT
Begin DoDot:3
+11 SET PB=$PIECE(^AUPNPROB(PIEN,0),U,1)
+12 IF $DATA(MPARMS("PROB"))
IF '$DATA(MPARMS("PROB",PB))
QUIT
+13 IF '$DATA(MPARMS("PROB"))
IF PB'=PROB
QUIT
+14 SET STAT=$PIECE(^AUPNPROB(PIEN,0),U,12)
+15 IF PRSTAT'=""
IF STAT'=PRSTAT
QUIT
+16 IF $DATA(MPARMS("PRSTAT"))
IF '$DATA(MPARMS("PRSTAT",STAT))
QUIT
+17 SET VSDTM=$$PROB^BQIUL1(PIEN)
+18 IF FDT'=""
IF VSDTM<FDT!(VSDTM>TDT)
QUIT
+19 IF PROP="!"
SET @TGLOB@(IEN)=""
SET @CRIT@("PROB",IEN,PIEN)=""
QUIT
+20 IF PROP="&"
SET PRPT(IEN,PROB)=PIEN
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+21 ;
+22 ; if no additional entries to filter by, build list by problem only to filter on
+23 NEW IEN,DFN,VSDTM,STAT
+24 SET IEN=""
+25 FOR
SET IEN=$ORDER(^AUPNPROB("B",PROB,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+26 SET DFN=$PIECE($GET(^AUPNPROB(IEN,0)),U,2)
+27 SET VSDTM=$$PROB^BQIUL1(IEN)
+28 IF FDT'=""
IF VSDTM<FDT!(VSDTM>TDT)
QUIT
+29 SET STAT=$PIECE(^AUPNPROB(IEN,0),U,12)
+30 IF PRSTAT'=""
IF STAT'=PRSTAT
QUIT
+31 IF $DATA(MPARMS("PRSTAT"))
IF '$DATA(MPARMS("PRSTAT",STAT))
QUIT
+32 IF DFN'=""
IF PROP="!"
SET @TGLOB@(DFN)=""
SET @CRIT@("PROB",DFN,IEN)=""
QUIT
+33 IF DFN'=""
IF PROP="&"
SET PRPT(DFN,PROB)=IEN
End DoDot:1
+34 ;
+35 QUIT
+36 ;
NRV(FGLOB,TGLOB,FDT,TDT) ;EP - problems not reviewed
+1 NEW DFN,BGT,EDT,OK
+2 IF $GET(FGLOB)=""
Begin DoDot:1
+3 SET DFN=0
+4 FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF 'DFN
QUIT
Begin DoDot:2
+5 IF $GET(^AUPNPAT(DFN,0))=""
QUIT
+6 IF '$DATA(^AUPNVRUP("AA",DFN,1))
SET @TGLOB@(DFN)=""
QUIT
+7 SET OK=0
+8 IF FDT'=""
Begin DoDot:3
+9 SET BGT=(9999999-TDT)-.0001
SET EDT=9999999-FDT
+10 FOR
SET BGT=$ORDER(^AUPNVRUP("AA",DFN,1,BGT))
IF BGT=""!(BGT\1>EDT)
QUIT
SET OK=1
End DoDot:3
QUIT
+11 IF 'OK
SET @TGLOB@(DFN)=""
End DoDot:2
End DoDot:1
+12 ;
+13 IF $GET(FGLOB)'=""
Begin DoDot:1
+14 SET DFN=""
+15 FOR
SET DFN=$ORDER(@FGLOB@(DFN))
IF DFN=""
QUIT
Begin DoDot:2
+16 IF '$DATA(^AUPNVRUP("AA",DFN,1))
SET @TGLOB@(DFN)=""
QUIT
+17 SET OK=0
+18 IF FDT'=""
Begin DoDot:3
+19 SET BGT=(9999999-TDT)-.0001
SET EDT=9999999-FDT
+20 FOR
SET BGT=$ORDER(^AUPNVRUP("AA",DFN,1,BGT))
IF BGT=""!(BGT\1>EDT)
QUIT
SET OK=1
End DoDot:3
+21 IF 'OK
SET @TGLOB@(DFN)=""
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
VCHK ;EP
+1 IF '$DATA(^AUPNVRUP("AC",DFN))
SET @TGLOB@(DFN)=""
QUIT
+2 IF '$DATA(^AUPNVRUP("AA",DFN,1))
SET @TGLOB@(DFN)=""
+3 QUIT
+4 ;
NAC(FGLOB,TGLOB,FDT,TDT) ;EP - No active problems
+1 NEW DFN
+2 IF $GET(FGLOB)=""
Begin DoDot:1
+3 SET DFN=0
+4 FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF 'DFN
QUIT
Begin DoDot:2
+5 IF $GET(^AUPNPAT(DFN,0))=""
QUIT
+6 IF $DATA(^AUPNVRUP("AA",DFN,3))
Begin DoDot:3
+7 IF FDT'=""
Begin DoDot:4
+8 SET BGT=(9999999-TDT)-.0001
SET EDT=9999999-FDT
+9 FOR
SET BGT=$ORDER(^AUPNVRUP("AA",DFN,3,BGT))
IF BGT=""!(BGT\1>EDT)
QUIT
SET @TGLOB@(DFN)=""
End DoDot:4
QUIT
+10 SET @TGLOB@(DFN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+11 ;
+12 IF $GET(FGLOB)'=""
Begin DoDot:1
+13 SET DFN=""
+14 FOR
SET DFN=$ORDER(@FGLOB@(DFN))
IF DFN=""
QUIT
Begin DoDot:2
+15 IF $DATA(^AUPNVRUP("AA",DFN,3))
Begin DoDot:3
+16 IF FDT'=""
Begin DoDot:4
+17 SET BGT=(9999999-TDT)-.0001
SET EDT=9999999-FDT
+18 FOR
SET BGT=$ORDER(^AUPNVRUP("AA",DFN,3,BGT))
IF BGT=""!(BGT\1>EDT)
QUIT
SET @TGLOB@(DFN)=""
End DoDot:4
QUIT
+19 SET @TGLOB@(DFN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+20 QUIT
+21 ;
NDC(FGLOB,TGLOB) ;EP - No documented problems
+1 NEW DFN
+2 IF $GET(FGLOB)=""
Begin DoDot:1
+3 SET DFN=0
+4 FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF 'DFN
QUIT
Begin DoDot:2
+5 IF $GET(^AUPNPAT(DFN,0))=""
QUIT
+6 IF '$DATA(^AUPNPROB("AC",DFN))
SET @TGLOB@(DFN)=""
End DoDot:2
End DoDot:1
+7 IF $GET(FGLOB)'=""
Begin DoDot:1
+8 SET DFN=""
+9 FOR
SET DFN=$ORDER(@FGLOB@(DFN))
IF DFN=""
QUIT
Begin DoDot:2
+10 IF '$DATA(^AUPNPROB("AC",DFN))
SET @TGLOB@(DFN)=""
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
MND(FGLOB,TGLOB) ;EP - No documented medications
+1 NEW DFN
+2 IF $GET(FGLOB)=""
Begin DoDot:1
+3 SET DFN=0
+4 FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF 'DFN
QUIT
Begin DoDot:2
+5 IF $GET(^AUPNPAT(DFN,0))=""
QUIT
+6 IF '$DATA(^AUPNVMED("AC",DFN))
SET @TGLOB@(DFN)=""
End DoDot:2
End DoDot:1
+7 IF $GET(FGLOB)'=""
Begin DoDot:1
+8 SET DFN=""
+9 FOR
SET DFN=$ORDER(@FGLOB@(DFN))
IF DFN=""
QUIT
Begin DoDot:2
+10 IF '$DATA(^AUPNVMED("AC",DFN))
SET @TGLOB@(DFN)=""
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
NAM(FGLOB,TGLOB,FDT,TDT) ;EP - no active medications
+1 NEW DFN
+2 IF $GET(FGLOB)=""
Begin DoDot:1
+3 SET DFN=0
+4 FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF 'DFN
QUIT
Begin DoDot:2
+5 IF $GET(^AUPNPAT(DFN,0))=""
QUIT
+6 IF $DATA(^AUPNVRUP("AA",DFN,7))
Begin DoDot:3
+7 IF FDT'=""
Begin DoDot:4
+8 SET BGT=(9999999-TDT)-.0001
SET EDT=9999999-FDT
+9 FOR
SET BGT=$ORDER(^AUPNVRUP("AA",DFN,7,BGT))
IF BGT=""!(BGT\1>EDT)
QUIT
SET @TGLOB@(DFN)=""
End DoDot:4
QUIT
+10 SET @TGLOB@(DFN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+11 ;
+12 IF $GET(FGLOB)'=""
Begin DoDot:1
+13 SET DFN=""
+14 FOR
SET DFN=$ORDER(@FGLOB@(DFN))
IF DFN=""
QUIT
Begin DoDot:2
+15 IF $DATA(^AUPNVRUP("AA",DFN,7))
Begin DoDot:3
+16 IF FDT'=""
Begin DoDot:4
+17 SET BGT=(9999999-TDT)-.0001
SET EDT=9999999-FDT
+18 FOR
SET BGT=$ORDER(^AUPNVRUP("AA",DFN,7,BGT))
IF BGT=""!(BGT\1>EDT)
QUIT
SET @TGLOB@(DFN)=""
End DoDot:4
QUIT
+19 SET @TGLOB@(DFN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+20 QUIT
+21 ;
MLR(FGLOB,TGLOB,FDT,TDT) ;EP - medications not reviewed
+1 NEW DFN,BGT,EDT,OK
+2 IF $GET(FGLOB)=""
Begin DoDot:1
+3 SET DFN=0
+4 FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF 'DFN
QUIT
Begin DoDot:2
+5 IF $GET(^AUPNPAT(DFN,0))=""
QUIT
+6 IF '$DATA(^AUPNVRUP("AA",DFN,5))
SET @TGLOB@(DFN)=""
QUIT
+7 SET OK=0
+8 IF FDT'=""
Begin DoDot:3
+9 SET BGT=(9999999-TDT)-.0001
SET EDT=9999999-FDT
+10 FOR
SET BGT=$ORDER(^AUPNVRUP("AA",DFN,5,BGT))
IF BGT=""!(BGT\1>EDT)
QUIT
SET OK=1
End DoDot:3
QUIT
+11 IF 'OK
SET @TGLOB@(DFN)=""
End DoDot:2
End DoDot:1
+12 ;
+13 IF $GET(FGLOB)'=""
Begin DoDot:1
+14 SET DFN=""
+15 FOR
SET DFN=$ORDER(@FGLOB@(DFN))
IF DFN=""
QUIT
Begin DoDot:2
+16 IF '$DATA(^AUPNVRUP("AA",DFN,5))
SET @TGLOB@(DFN)=""
QUIT
+17 SET OK=0
+18 IF FDT'=""
Begin DoDot:3
+19 SET BGT=(9999999-TDT)-.0001
SET EDT=9999999-FDT
+20 FOR
SET BGT=$ORDER(^AUPNVRUP("AA",DFN,5,BGT))
IF BGT=""!(BGT\1>EDT)
QUIT
SET OK=1
End DoDot:3
+21 IF 'OK
SET @TGLOB@(DFN)=""
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
EMP(FGLOB,TGLOB,EMPL,MPARMS) ;EP - Employer search
+1 IF $GET(TGLOB)=""
QUIT
+2 IF $GET(EMPL)'=""
Begin DoDot:1
+3 SET EMPL=""
+4 FOR
SET EMPL=$ORDER(^BQI(90508,1,18,"B",EMPL))
IF EMPL=""
QUIT
DO EMD
End DoDot:1
+5 QUIT
+6 ;
EMD ;EP
+1 NEW IEN,DFN
+2 IF $GET(FGLOB)'=""
Begin DoDot:1
+3 SET IEN=""
+4 FOR
SET IEN=$ORDER(@FGLOB@(IEN))
IF 'IEN
QUIT
IF $PIECE($GET(^AUPNPAT(IEN,0)),U,19)=EMPL
SET @TGLOB@(IEN)=""
End DoDot:1
+5 ;
+6 IF $GET(FGLOB)=""
Begin DoDot:1
+7 SET DFN=""
+8 FOR
SET DFN=$ORDER(^AUPNPAT("AF",EMPL,DFN))
IF DFN=""
QUIT
SET @TGLOB@(DFN)=""
End DoDot:1
+9 QUIT
+10 ;
PNL(FGLOB,TGLOB,PLIDEN,MPARMS) ;EP - Panel search
+1 IF $GET(TGLOB)=""
QUIT
+2 IF PLIDEN]""
DO PLD
+3 IF $DATA(MPARMS("PLIDEN"))
SET PLIDEN=""
FOR
SET PLIDEN=$ORDER(MPARMS("PLIDEN",PLIDEN))
IF PLIDEN=""
QUIT
DO PLD
+4 QUIT
+5 ;
PLD ;EP
+1 NEW OWNR,PLNME,DA,IENS,PLIEN
+2 SET OWNR=$PIECE(PLIDEN,$CHAR(26),1)
SET PLNME=$PIECE(PLIDEN,$CHAR(26),2)
+3 SET DA=""
SET DA(1)=OWNR
SET IENS=$$IENS^DILF(.DA)
+4 SET PLIEN=$$FIND1^DIC(90505.01,IENS,"X",PLNME,"","","ERROR")
+5 IF PLIEN=""
QUIT
+6 IF $GET(FGLOB)'=""
Begin DoDot:1
+7 SET IEN=""
+8 FOR
SET IEN=$ORDER(@FGLOB@(IEN))
IF 'IEN
QUIT
Begin DoDot:2
+9 IF $DATA(^BQICARE(OWNR,1,PLIEN,40,IEN))
IF $PIECE(^BQICARE(OWNR,1,PLIEN,40,IEN,0),U,2)'="R"
SET @TGLOB@(IEN)=""
End DoDot:2
End DoDot:1
+10 ;
+11 NEW DFN,IEN
+12 IF $GET(FGLOB)=""
Begin DoDot:1
+13 SET DFN=0
+14 FOR
SET DFN=$ORDER(^BQICARE(OWNR,1,PLIEN,40,DFN))
IF 'DFN
QUIT
Begin DoDot:2
+15 IF $PIECE(^BQICARE(OWNR,1,PLIEN,40,DFN,0),U,2)="R"
QUIT
+16 SET @TGLOB@(DFN)=""
End DoDot:2
End DoDot:1
+17 QUIT
