BQIPLUTL ;PRXM/HC/ALA-Panel Utilities ; 27 Dec 2006 2:20 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
SXRF ; Set cross-reference
;I $G(DA(3))="" Q
NEW V3,V2,V1
S V3=$S($G(DA(3))'="":DA(3),1:DA(2))
S V2=$S($G(DA(3))'="":DA(2),1:DA(1))
S V1=$S($G(DA(3))'="":DA(1),1:DA)
I $P($G(^BQICARE(V3,1,V2,15,V1,0)),U,1)'="PLIDEN" Q
S ^BQICARE("AD",X,V3,V2,V1)=""
Q
;
KXRF ; Kill cross-reference
;I $G(DA(3))="" Q
NEW V3,V2,V1
S V3=$S($G(DA(3))'="":DA(3),1:DA(2))
S V2=$S($G(DA(3))'="":DA(2),1:DA(1))
S V1=$S($G(DA(3))'="":DA(1),1:DA)
I $P($G(^BQICARE(V3,1,V2,15,V1,0)),U,1)'="PLIDEN" Q
K ^BQICARE("AD",X,V3,V2,V1)
Q
;
CPFL(OWNR,PLIEN) ;EP -- Contains a panel filter
; Does the passed owner and panel contain a panel filter value, then lock those panels
;Input
; OWNR = owner of the panel
; PLIEN = panel ien
NEW FIL,VALUE,POWNR,PPLIEN,TN,SUCC,PPNME
S FIL="",SUCC=1
F S FIL=$O(^BQICARE(OWNR,1,PLIEN,15,"B","PLIDEN",FIL)) Q:FIL="" D
. I $P(^BQICARE(OWNR,1,PLIEN,15,FIL,0),U,2)'="" D Q
.. S VALUE=$P(^BQICARE(OWNR,1,PLIEN,15,FIL,0),U,2)
.. S POWNR=$P(VALUE,$C(26),1),PPNME=$P(VALUE,$C(26),2) Q:PPNME=""
.. S PPLIEN=$O(^BQICARE(POWNR,1,"B",PPNME,"")) Q:PPLIEN=""
.. S LOCK=$$LCK^BQIPLRF(POWNR,PPLIEN)
.. I 'LOCK S SUCC=0
. S TN=0
. F S TN=$O(^BQICARE(OWNR,1,PLIEN,15,FIL,1,TN)) Q:'TN D Q:'SUCC
.. S VALUE=$P(^BQICARE(OWNR,1,PLIEN,15,FIL,1,TN,0),U,1)
.. S POWNR=$P(VALUE,$C(26),1),PPNME=$P(VALUE,$C(26),2) Q:PPNME=""
.. S PPLIEN=$O(^BQICARE(POWNR,1,"B",PPNME,"")) Q:PPLIEN=""
.. S LOCK=$$LCK^BQIPLRF(POWNR,PPLIEN)
.. I 'LOCK S SUCC=0_"^"_$P(LOCK,U,2)_"^"_$G(BMXSEC)_"^"_POWNR_"^"_PPLIEN
;
I 'SUCC D
. S FIL=""
. F S FIL=$O(^BQICARE(OWNR,1,PLIEN,15,"B","PLIDEN",FIL)) Q:FIL="" D
.. I $P(^BQICARE(OWNR,1,PLIEN,15,FIL,0),U,2)'="" Q
.. S TN=0
.. F S TN=$O(^BQICARE(OWNR,1,PLIEN,15,FIL,1,TN)) Q:'TN D
... S VALUE=$P(^BQICARE(OWNR,1,PLIEN,15,FIL,1,TN,0),U,1)
... S POWNR=$P(VALUE,$C(26),1),PPNME=$P(VALUE,$C(26),2) Q:PPNME=""
... S PPLIEN=$O(^BQICARE(POWNR,1,"B",PPNME,"")) Q:PPLIEN=""
... D ULK^BQIPLRF(POWNR,PPLIEN)
Q SUCC
;
CPFLU(OWNR,PLIEN) ;EP - Contains a panel filter unlock
NEW FIL,VALUE,POWNR,PPLIEN,TN,PPNME
S FIL=""
F S FIL=$O(^BQICARE(OWNR,1,PLIEN,15,"B","PLIDEN",FIL)) Q:FIL="" D
. I $P(^BQICARE(OWNR,1,PLIEN,15,FIL,0),U,2)'="" D Q
.. S VALUE=$P(^BQICARE(OWNR,1,PLIEN,15,FIL,0),U,2)
.. S POWNR=$P(VALUE,$C(26),1),PPNME=$P(VALUE,$C(26),2) Q:PPNME=""
.. S PPLIEN=$O(^BQICARE(POWNR,1,"B",PPNME,"")) Q:PPLIEN=""
.. D ULK^BQIPLRF(POWNR,PPLIEN)
. S TN=0
. F S TN=$O(^BQICARE(OWNR,1,PLIEN,15,FIL,1,TN)) Q:'TN D
.. S VALUE=$P(^BQICARE(OWNR,1,PLIEN,15,FIL,1,TN,0),U,1)
.. S POWNR=$P(VALUE,$C(26),1),PPNME=$P(VALUE,$C(26),2) Q:PPNME=""
.. S PPLIEN=$O(^BQICARE(POWNR,1,"B",PPNME,"")) Q:PPLIEN=""
.. D ULK^BQIPLRF(POWNR,PPLIEN)
Q
;
PFILL(OWNR,PLIEN,PLIDEN) ;EP - Lock panel filters or send a notification
NEW TEXT,TEXT1,POWNR,PPLIEN,LOCK
S TEXT=" who is using it as a filter.",TEXT1=""
S POWNR=""
F S POWNR=$O(^BQICARE("AD",PLIDEN,POWNR)) Q:POWNR="" D Q:LFLG
. S PPLIEN=""
. F S PPLIEN=$O(^BQICARE("AD",PLIDEN,POWNR,PPLIEN)) Q:PPLIEN="" D Q:LFLG
.. S LOCK=$$LCK^BQIPLRF(POWNR,PPLIEN) Q:LOCK
.. S LFLG=1
.. S TEXT1=" panel "_$P(^BQICARE(POWNR,1,PPLIEN,0),U,1)_TEXT
.. D NOT^BQIPLRF(OWNR,PLIEN,TEXT1)
Q
;
PFILU(OWNR,PLIEN,PLIDEN) ;EP - Unlock panel filters locked earlier
NEW POWNR,PPLIEN
S POWNR=""
F S POWNR=$O(^BQICARE("AD",PLIDEN,POWNR)) Q:POWNR="" D
. S PPLIEN=""
. F S PPLIEN=$O(^BQICARE("AD",PLIDEN,POWNR,PPLIEN)) Q:PPLIEN="" D ULK^BQIPLRF(POWNR,PPLIEN)
Q
BQIPLUTL ;PRXM/HC/ALA-Panel Utilities ; 27 Dec 2006 2:20 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
SXRF ; Set cross-reference
+1 ;I $G(DA(3))="" Q
+2 NEW V3,V2,V1
+3 SET V3=$SELECT($GET(DA(3))'="":DA(3),1:DA(2))
+4 SET V2=$SELECT($GET(DA(3))'="":DA(2),1:DA(1))
+5 SET V1=$SELECT($GET(DA(3))'="":DA(1),1:DA)
+6 IF $PIECE($GET(^BQICARE(V3,1,V2,15,V1,0)),U,1)'="PLIDEN"
QUIT
+7 SET ^BQICARE("AD",X,V3,V2,V1)=""
+8 QUIT
+9 ;
KXRF ; Kill cross-reference
+1 ;I $G(DA(3))="" Q
+2 NEW V3,V2,V1
+3 SET V3=$SELECT($GET(DA(3))'="":DA(3),1:DA(2))
+4 SET V2=$SELECT($GET(DA(3))'="":DA(2),1:DA(1))
+5 SET V1=$SELECT($GET(DA(3))'="":DA(1),1:DA)
+6 IF $PIECE($GET(^BQICARE(V3,1,V2,15,V1,0)),U,1)'="PLIDEN"
QUIT
+7 KILL ^BQICARE("AD",X,V3,V2,V1)
+8 QUIT
+9 ;
CPFL(OWNR,PLIEN) ;EP -- Contains a panel filter
+1 ; Does the passed owner and panel contain a panel filter value, then lock those panels
+2 ;Input
+3 ; OWNR = owner of the panel
+4 ; PLIEN = panel ien
+5 NEW FIL,VALUE,POWNR,PPLIEN,TN,SUCC,PPNME
+6 SET FIL=""
SET SUCC=1
+7 FOR
SET FIL=$ORDER(^BQICARE(OWNR,1,PLIEN,15,"B","PLIDEN",FIL))
IF FIL=""
QUIT
Begin DoDot:1
+8 IF $PIECE(^BQICARE(OWNR,1,PLIEN,15,FIL,0),U,2)'=""
Begin DoDot:2
+9 SET VALUE=$PIECE(^BQICARE(OWNR,1,PLIEN,15,FIL,0),U,2)
+10 SET POWNR=$PIECE(VALUE,$CHAR(26),1)
SET PPNME=$PIECE(VALUE,$CHAR(26),2)
IF PPNME=""
QUIT
+11 SET PPLIEN=$ORDER(^BQICARE(POWNR,1,"B",PPNME,""))
IF PPLIEN=""
QUIT
+12 SET LOCK=$$LCK^BQIPLRF(POWNR,PPLIEN)
+13 IF 'LOCK
SET SUCC=0
End DoDot:2
QUIT
+14 SET TN=0
+15 FOR
SET TN=$ORDER(^BQICARE(OWNR,1,PLIEN,15,FIL,1,TN))
IF 'TN
QUIT
Begin DoDot:2
+16 SET VALUE=$PIECE(^BQICARE(OWNR,1,PLIEN,15,FIL,1,TN,0),U,1)
+17 SET POWNR=$PIECE(VALUE,$CHAR(26),1)
SET PPNME=$PIECE(VALUE,$CHAR(26),2)
IF PPNME=""
QUIT
+18 SET PPLIEN=$ORDER(^BQICARE(POWNR,1,"B",PPNME,""))
IF PPLIEN=""
QUIT
+19 SET LOCK=$$LCK^BQIPLRF(POWNR,PPLIEN)
+20 IF 'LOCK
SET SUCC=0_"^"_$PIECE(LOCK,U,2)_"^"_$GET(BMXSEC)_"^"_POWNR_"^"_PPLIEN
End DoDot:2
IF 'SUCC
QUIT
End DoDot:1
+21 ;
+22 IF 'SUCC
Begin DoDot:1
+23 SET FIL=""
+24 FOR
SET FIL=$ORDER(^BQICARE(OWNR,1,PLIEN,15,"B","PLIDEN",FIL))
IF FIL=""
QUIT
Begin DoDot:2
+25 IF $PIECE(^BQICARE(OWNR,1,PLIEN,15,FIL,0),U,2)'=""
QUIT
+26 SET TN=0
+27 FOR
SET TN=$ORDER(^BQICARE(OWNR,1,PLIEN,15,FIL,1,TN))
IF 'TN
QUIT
Begin DoDot:3
+28 SET VALUE=$PIECE(^BQICARE(OWNR,1,PLIEN,15,FIL,1,TN,0),U,1)
+29 SET POWNR=$PIECE(VALUE,$CHAR(26),1)
SET PPNME=$PIECE(VALUE,$CHAR(26),2)
IF PPNME=""
QUIT
+30 SET PPLIEN=$ORDER(^BQICARE(POWNR,1,"B",PPNME,""))
IF PPLIEN=""
QUIT
+31 DO ULK^BQIPLRF(POWNR,PPLIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+32 QUIT SUCC
+33 ;
CPFLU(OWNR,PLIEN) ;EP - Contains a panel filter unlock
+1 NEW FIL,VALUE,POWNR,PPLIEN,TN,PPNME
+2 SET FIL=""
+3 FOR
SET FIL=$ORDER(^BQICARE(OWNR,1,PLIEN,15,"B","PLIDEN",FIL))
IF FIL=""
QUIT
Begin DoDot:1
+4 IF $PIECE(^BQICARE(OWNR,1,PLIEN,15,FIL,0),U,2)'=""
Begin DoDot:2
+5 SET VALUE=$PIECE(^BQICARE(OWNR,1,PLIEN,15,FIL,0),U,2)
+6 SET POWNR=$PIECE(VALUE,$CHAR(26),1)
SET PPNME=$PIECE(VALUE,$CHAR(26),2)
IF PPNME=""
QUIT
+7 SET PPLIEN=$ORDER(^BQICARE(POWNR,1,"B",PPNME,""))
IF PPLIEN=""
QUIT
+8 DO ULK^BQIPLRF(POWNR,PPLIEN)
End DoDot:2
QUIT
+9 SET TN=0
+10 FOR
SET TN=$ORDER(^BQICARE(OWNR,1,PLIEN,15,FIL,1,TN))
IF 'TN
QUIT
Begin DoDot:2
+11 SET VALUE=$PIECE(^BQICARE(OWNR,1,PLIEN,15,FIL,1,TN,0),U,1)
+12 SET POWNR=$PIECE(VALUE,$CHAR(26),1)
SET PPNME=$PIECE(VALUE,$CHAR(26),2)
IF PPNME=""
QUIT
+13 SET PPLIEN=$ORDER(^BQICARE(POWNR,1,"B",PPNME,""))
IF PPLIEN=""
QUIT
+14 DO ULK^BQIPLRF(POWNR,PPLIEN)
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
PFILL(OWNR,PLIEN,PLIDEN) ;EP - Lock panel filters or send a notification
+1 NEW TEXT,TEXT1,POWNR,PPLIEN,LOCK
+2 SET TEXT=" who is using it as a filter."
SET TEXT1=""
+3 SET POWNR=""
+4 FOR
SET POWNR=$ORDER(^BQICARE("AD",PLIDEN,POWNR))
IF POWNR=""
QUIT
Begin DoDot:1
+5 SET PPLIEN=""
+6 FOR
SET PPLIEN=$ORDER(^BQICARE("AD",PLIDEN,POWNR,PPLIEN))
IF PPLIEN=""
QUIT
Begin DoDot:2
+7 SET LOCK=$$LCK^BQIPLRF(POWNR,PPLIEN)
IF LOCK
QUIT
+8 SET LFLG=1
+9 SET TEXT1=" panel "_$PIECE(^BQICARE(POWNR,1,PPLIEN,0),U,1)_TEXT
+10 DO NOT^BQIPLRF(OWNR,PLIEN,TEXT1)
End DoDot:2
IF LFLG
QUIT
End DoDot:1
IF LFLG
QUIT
+11 QUIT
+12 ;
PFILU(OWNR,PLIEN,PLIDEN) ;EP - Unlock panel filters locked earlier
+1 NEW POWNR,PPLIEN
+2 SET POWNR=""
+3 FOR
SET POWNR=$ORDER(^BQICARE("AD",PLIDEN,POWNR))
IF POWNR=""
QUIT
Begin DoDot:1
+4 SET PPLIEN=""
+5 FOR
SET PPLIEN=$ORDER(^BQICARE("AD",PLIDEN,POWNR,PPLIEN))
IF PPLIEN=""
QUIT
DO ULK^BQIPLRF(POWNR,PPLIEN)
End DoDot:1
+6 QUIT
