- 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