BOPSET ;IHS/ILC/ALG/CIA/PLS - Build Item Index in 90355.1;06-Apr-2005 13:41;SM
;;1.0;AUTOMATED DISPENSING INTERFACE;;Jul 26, 2005
; Index ^BOP(90355.1,"ITM",patient DFN,orderIEN,drugIEN, 4 20 or 21 from node) =
; drug or iv ^ BOP(90355.1 transaction # ^ what file the drug
; is from ^ order status ^ subnode for 20.1 or 21.1 ex: 20-1
;
IN1 ; Entry from 4.01 field
N A,B,C,D
S A=$P($G(^BOP(90355.1,DA,1)),U,1),B=$G(^BOP(90355.1,DA,2))
S C=$P($G(^BOP(90355.1,DA,4)),U,1),D=$P($G(^BOP(90355.1,DA,5)),U,11)
I A=""!($P(B,U,2)="")!(C="") Q ; do not set nill nodes
S ^BOP(90355.1,"ITM",A,$P(B,U,2),C,4)=$S(D["PS(":"IV",1:"DRUG")_U_DA_U_D_U_$P(B,U,1)_U
I D["PS(" S ^BOP(90355.1,"AIV",A,DA)=""
K A,B,C,D
Q
;
IN1K(DA1) ; remove
N A,B,C,D,E
S A=$P($G(^BOP(90355.1,DA1,1)),U,1),B=$G(^BOP(90355.1,DA1,2))
S C=$P($G(^BOP(90355.1,DA1,4)),U,1),D=$P($G(^BOP(90355.1,DA1,5)),U,11)
I A=""!($P(B,U,2)="")!(C="") Q ; do not kill nill nodes
K ^BOP(90355.1,"ITM",A,$P(B,U,2),C,4)
I D["PS(" K ^BOP(90355.1,"AIV",A,DA1)
K A,B,C,D
Q
;
IN20 ; EP - Entry from solutions node 20
N A,B,C,D,E
S A=$P($G(^BOP(90355.1,DA(1),1)),U,1),B=$G(^BOP(90355.1,DA(1),2))
S E=$G(^BOP(90355.1,DA(1),20,DA,0)),C=$P(E,U,1),D=$P(E,U,11)
I A=""!($P(B,U,2)="")!(C="") Q ; do not set nill nodes
S ^BOP(90355.1,"ITM",A,$P(B,U,2),C,20)="IV^"_DA(1)_U_D_U_$P(B,U,1)_U_"20-"_DA
S ^BOP(90355.1,"AIV",A,DA(1))=""
K A,B,C,D,E
Q
;
IN20K(DA1) ; remove soultions indexs
N A,B,C,D,E,F,G
S G=0 F S G=$O(^BOP(90355.1,DA1,20,G)) Q:'G D
. S A=$P($G(^BOP(90355.1,DA1,1)),U,1),B=$G(^BOP(90355.1,DA1,2))
. S E=$G(^BOP(90355.1,DA1,G,0)),C=$P(E,U,1),D=$P(E,U,11)
. I A=""!($P(B,U,2)="")!(C="") Q ; do not kill nill nodes
. K ^BOP(90355.1,"ITM",A,$P(B,U,2),C,20)
. K ^BOP(90355.1,"AIV",A,DA1)
. Q
K A,B,C,D,E,F,G
Q
;
IN21 ; EP - Entry from additives node 21
N A,B,C,D,E
S A=$P($G(^BOP(90355.1,DA(1),1)),U,1),B=$G(^BOP(90355.1,DA(1),2))
S E=$G(^BOP(90355.1,DA(1),21,DA,0)),C=$P(E,U,1),D=$P(E,U,11)
I A=""!($P(B,U,2)="")!(C="") Q ; do not set nill nodes
S ^BOP(90355.1,"ITM",A,$P(B,U,2),C,21)="IV^"_DA(1)_U_D_U_$P(B,U,1)_U_"21-"_DA
S ^BOP(90355.1,"AIV",A,DA(1))=""
K A,B,C,D,E
Q
;
IN21K(DA1) ; remove additives index items
N A,B,C,D,E,F,G
S G=0 F S G=$O(^BOP(90355.1,DA1,21,G)) Q:'G D
. S A=$P($G(^BOP(90355.1,DA1,1)),U,1),B=$G(^BOP(90355.1,DA1,2))
. S E=$G(^BOP(90355.1,DA1,G,0)),C=$P(E,U,1),D=$P(E,U,11)
. I A=""!($P(B,U,2)="")!(C="") Q ; do not kill nill nodes
. K ^BOP(90355.1,"ITM",A,$P(B,U,2),C,21)
. K ^BOP(90355.1,"AIV",A,DA1)
. Q
K A,B,C,D,E,F,G
Q
BOPSET ;IHS/ILC/ALG/CIA/PLS - Build Item Index in 90355.1;06-Apr-2005 13:41;SM
+1 ;;1.0;AUTOMATED DISPENSING INTERFACE;;Jul 26, 2005
+2 ; Index ^BOP(90355.1,"ITM",patient DFN,orderIEN,drugIEN, 4 20 or 21 from node) =
+3 ; drug or iv ^ BOP(90355.1 transaction # ^ what file the drug
+4 ; is from ^ order status ^ subnode for 20.1 or 21.1 ex: 20-1
+5 ;
IN1 ; Entry from 4.01 field
+1 NEW A,B,C,D
+2 SET A=$PIECE($GET(^BOP(90355.1,DA,1)),U,1)
SET B=$GET(^BOP(90355.1,DA,2))
+3 SET C=$PIECE($GET(^BOP(90355.1,DA,4)),U,1)
SET D=$PIECE($GET(^BOP(90355.1,DA,5)),U,11)
+4 ; do not set nill nodes
IF A=""!($PIECE(B,U,2)="")!(C="")
QUIT
+5 SET ^BOP(90355.1,"ITM",A,$PIECE(B,U,2),C,4)=$SELECT(D["PS(":"IV",1:"DRUG")_U_DA_U_D_U_$PIECE(B,U,1)_U
+6 IF D["PS("
SET ^BOP(90355.1,"AIV",A,DA)=""
+7 KILL A,B,C,D
+8 QUIT
+9 ;
IN1K(DA1) ; remove
+1 NEW A,B,C,D,E
+2 SET A=$PIECE($GET(^BOP(90355.1,DA1,1)),U,1)
SET B=$GET(^BOP(90355.1,DA1,2))
+3 SET C=$PIECE($GET(^BOP(90355.1,DA1,4)),U,1)
SET D=$PIECE($GET(^BOP(90355.1,DA1,5)),U,11)
+4 ; do not kill nill nodes
IF A=""!($PIECE(B,U,2)="")!(C="")
QUIT
+5 KILL ^BOP(90355.1,"ITM",A,$PIECE(B,U,2),C,4)
+6 IF D["PS("
KILL ^BOP(90355.1,"AIV",A,DA1)
+7 KILL A,B,C,D
+8 QUIT
+9 ;
IN20 ; EP - Entry from solutions node 20
+1 NEW A,B,C,D,E
+2 SET A=$PIECE($GET(^BOP(90355.1,DA(1),1)),U,1)
SET B=$GET(^BOP(90355.1,DA(1),2))
+3 SET E=$GET(^BOP(90355.1,DA(1),20,DA,0))
SET C=$PIECE(E,U,1)
SET D=$PIECE(E,U,11)
+4 ; do not set nill nodes
IF A=""!($PIECE(B,U,2)="")!(C="")
QUIT
+5 SET ^BOP(90355.1,"ITM",A,$PIECE(B,U,2),C,20)="IV^"_DA(1)_U_D_U_$PIECE(B,U,1)_U_"20-"_DA
+6 SET ^BOP(90355.1,"AIV",A,DA(1))=""
+7 KILL A,B,C,D,E
+8 QUIT
+9 ;
IN20K(DA1) ; remove soultions indexs
+1 NEW A,B,C,D,E,F,G
+2 SET G=0
FOR
SET G=$ORDER(^BOP(90355.1,DA1,20,G))
IF 'G
QUIT
Begin DoDot:1
+3 SET A=$PIECE($GET(^BOP(90355.1,DA1,1)),U,1)
SET B=$GET(^BOP(90355.1,DA1,2))
+4 SET E=$GET(^BOP(90355.1,DA1,G,0))
SET C=$PIECE(E,U,1)
SET D=$PIECE(E,U,11)
+5 ; do not kill nill nodes
IF A=""!($PIECE(B,U,2)="")!(C="")
QUIT
+6 KILL ^BOP(90355.1,"ITM",A,$PIECE(B,U,2),C,20)
+7 KILL ^BOP(90355.1,"AIV",A,DA1)
+8 QUIT
End DoDot:1
+9 KILL A,B,C,D,E,F,G
+10 QUIT
+11 ;
IN21 ; EP - Entry from additives node 21
+1 NEW A,B,C,D,E
+2 SET A=$PIECE($GET(^BOP(90355.1,DA(1),1)),U,1)
SET B=$GET(^BOP(90355.1,DA(1),2))
+3 SET E=$GET(^BOP(90355.1,DA(1),21,DA,0))
SET C=$PIECE(E,U,1)
SET D=$PIECE(E,U,11)
+4 ; do not set nill nodes
IF A=""!($PIECE(B,U,2)="")!(C="")
QUIT
+5 SET ^BOP(90355.1,"ITM",A,$PIECE(B,U,2),C,21)="IV^"_DA(1)_U_D_U_$PIECE(B,U,1)_U_"21-"_DA
+6 SET ^BOP(90355.1,"AIV",A,DA(1))=""
+7 KILL A,B,C,D,E
+8 QUIT
+9 ;
IN21K(DA1) ; remove additives index items
+1 NEW A,B,C,D,E,F,G
+2 SET G=0
FOR
SET G=$ORDER(^BOP(90355.1,DA1,21,G))
IF 'G
QUIT
Begin DoDot:1
+3 SET A=$PIECE($GET(^BOP(90355.1,DA1,1)),U,1)
SET B=$GET(^BOP(90355.1,DA1,2))
+4 SET E=$GET(^BOP(90355.1,DA1,G,0))
SET C=$PIECE(E,U,1)
SET D=$PIECE(E,U,11)
+5 ; do not kill nill nodes
IF A=""!($PIECE(B,U,2)="")!(C="")
QUIT
+6 KILL ^BOP(90355.1,"ITM",A,$PIECE(B,U,2),C,21)
+7 KILL ^BOP(90355.1,"AIV",A,DA1)
+8 QUIT
End DoDot:1
+9 KILL A,B,C,D,E,F,G
+10 QUIT
