- 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
