BIVGRP1 ;IHS/CMI/MWR - EDIT VACCINES.; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; EDIT VACCINE FIELDS: CURRENT LOT, ACTIVE, VIS DATE DEFAULT.
;
;
;----------
INIT ;EP
;---> Initialize variables and list array.
;
S VALMSG="Enter ""C"" to Change a Vaccine Group."
S VALM("TITLE")=" Immunization v"_$$VER^BILOGO
;
;---> Build Listmanager array.
K ^TMP("BIVGRP",$J),BIVAC
;
N BILINE,BIENT,BIN,BIVAC1,I
S BILINE=0,BIENT=0,BIN=0
S BIXREF="B"
;
F S BIN=$O(^BISERT(BIXREF,BIN)) Q:BIN="" D
.N BI0,BIIEN,X,Y
.S BIIEN=$O(^BISERT(BIXREF,BIN,0))
.Q:$D(BIVAC1(BIIEN))
.S BIVAC1(BIIEN)="",BI0=^BISERT(BIIEN,0)
.;--->Quit if this group should not be displayed.
.Q:'$P(BI0,U,6)
.;
.;---> Set Item# and build Item# array=IEN of Vaccine.
.S BIENT=BIENT+1,BIVAC(BIENT)=BIIEN
.;
.;---> Item#.
.S X=" "_$S(BIENT<10:" "_BIENT,1:BIENT)
.;
.;---> Vaccine (Short) Name.
.S X=X_" "_$P(BI0,U)
.S X=$$PAD^BIUTL5(X,24,".")
.;
.;---> Forecast Exclude/Include.
.S X=X_$S($P(BI0,U,5):"YES",1:"NO")
.;
.;---> Set this Vaccine display row and index in ^TMP.
.D WRITE(.BILINE,X,,BIENT)
.;D WRITE(.BILINE,,,BIENT)
;
;---> Finish up Listmanager List Count.
S VALMCNT=BILINE
I VALMCNT>12 D
.S VALMSG="Scroll down to view more. Type ?? for more actions."
Q
;
;
;----------
WRITE(BILINE,BIVAL,BIBLNK,BIENT) ;EP
;---> Write lines to ^TMP (see documentation in ^BIW).
;---> Parameters:
; 1 - BILINE (ret) Last line# written.
; 2 - BIVAL (opt) Value/text of line (Null=blank line).
;
Q:'$D(BILINE)
D WL^BIW(.BILINE,"BIVGRP",$G(BIVAL),$G(BIBLNK),$G(BIENT))
Q
;
;
;----------
EDIT ;EP
;---> Edit a Vaccine.
;---> Call the Listmanager Generic Selector of items displayed.
N VALMY
D EN^VALM2(XQORNOD(0),"OS")
;
;---> Check that a Listman Item was passed.
I '$D(VALMY) D ERRCD^BIUTL2(406,,1) D RESET Q
;---> Now set Y=Item# selected from the list.
N Y S Y=$O(VALMY(0))
I '$G(Y) D ERRCD^BIUTL2(406,,1) D RESET Q
I $G(BIVAC(Y))="" D ERRCD^BIUTL2(510,,1) D RESET Q
N BIDA S BIDA=+BIVAC(Y)
I $G(^BISERT(BIDA,0))="" D ERRCD^BIUTL2(510,,1) D RESET Q
;
;---> Save previous setting of Forecast Yes/No (0=YES,1=NO).
N BIFORC S BIFORC=$P(^BISERT(BIDA,0),U,5)
D
.I BIFORC=1 S $P(^BISERT(BIDA,0),U,5)=0 Q
.S $P(^BISERT(BIDA,0),U,5)=1
D RESET
Q
;
;
;----------
DISPLAY ;EP
I $G(BIPOP) D FULL^VALM1,RESET Q
;
;---> *** THE FOLLOWING CODE COULD BE USED TO DISPLAY WHICH VACCINES ARE
;---> AFFECTED BY TURNING ON/OFF A VACCINE GROUP. NOT USED FOR NOW. ***
D
.Q
.;
.N BINF D CONTRHL7^BIUTL11(BIDA,.BINF)
.Q:'$D(BINF)
.;
.N N,BIHDR S N=0
.F S N=$O(BINF(N)) Q:'N D
..N BIIEN S BIIEN=$$HL7TX^BIUTL2(N)
..Q:'BIIEN
..Q:BIIEN=BIDA
..D:'$G(BIHDR) S BIHDR=1
...W !!?5,"The following related Vaccines will also change:"
...W !!?5,"VACCINE FORECAST",!?5,"-----------------------"
..S $P(^AUTTIMM(BIIEN,0),U,16)=BIFORC1
..W !?5,$$VNAME^BIUTL2(BIIEN),?20,$S(BIFORC1:"NO",1:"YES")
;
D DIRZ^BIUTL3()
D FULL^VALM1
D RESET
Q
;
;
;----------
RESET ;EP
;---> Update partition for return to Listmanager.
I $D(VALMQUIT) S VALMBCK="Q" Q
D TERM^VALM0 S VALMBCK="R"
D INIT^BIVGRP,HDR^BIVGRP()
Q
BIVGRP1 ;IHS/CMI/MWR - EDIT VACCINES.; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; EDIT VACCINE FIELDS: CURRENT LOT, ACTIVE, VIS DATE DEFAULT.
+4 ;
+5 ;
+6 ;----------
INIT ;EP
+1 ;---> Initialize variables and list array.
+2 ;
+3 SET VALMSG="Enter ""C"" to Change a Vaccine Group."
+4 SET VALM("TITLE")=" Immunization v"_$$VER^BILOGO
+5 ;
+6 ;---> Build Listmanager array.
+7 KILL ^TMP("BIVGRP",$JOB),BIVAC
+8 ;
+9 NEW BILINE,BIENT,BIN,BIVAC1,I
+10 SET BILINE=0
SET BIENT=0
SET BIN=0
+11 SET BIXREF="B"
+12 ;
+13 FOR
SET BIN=$ORDER(^BISERT(BIXREF,BIN))
IF BIN=""
QUIT
Begin DoDot:1
+14 NEW BI0,BIIEN,X,Y
+15 SET BIIEN=$ORDER(^BISERT(BIXREF,BIN,0))
+16 IF $DATA(BIVAC1(BIIEN))
QUIT
+17 SET BIVAC1(BIIEN)=""
SET BI0=^BISERT(BIIEN,0)
+18 ;--->Quit if this group should not be displayed.
+19 IF '$PIECE(BI0,U,6)
QUIT
+20 ;
+21 ;---> Set Item# and build Item# array=IEN of Vaccine.
+22 SET BIENT=BIENT+1
SET BIVAC(BIENT)=BIIEN
+23 ;
+24 ;---> Item#.
+25 SET X=" "_$SELECT(BIENT<10:" "_BIENT,1:BIENT)
+26 ;
+27 ;---> Vaccine (Short) Name.
+28 SET X=X_" "_$PIECE(BI0,U)
+29 SET X=$$PAD^BIUTL5(X,24,".")
+30 ;
+31 ;---> Forecast Exclude/Include.
+32 SET X=X_$SELECT($PIECE(BI0,U,5):"YES",1:"NO")
+33 ;
+34 ;---> Set this Vaccine display row and index in ^TMP.
+35 DO WRITE(.BILINE,X,,BIENT)
+36 ;D WRITE(.BILINE,,,BIENT)
End DoDot:1
+37 ;
+38 ;---> Finish up Listmanager List Count.
+39 SET VALMCNT=BILINE
+40 IF VALMCNT>12
Begin DoDot:1
+41 SET VALMSG="Scroll down to view more. Type ?? for more actions."
End DoDot:1
+42 QUIT
+43 ;
+44 ;
+45 ;----------
WRITE(BILINE,BIVAL,BIBLNK,BIENT) ;EP
+1 ;---> Write lines to ^TMP (see documentation in ^BIW).
+2 ;---> Parameters:
+3 ; 1 - BILINE (ret) Last line# written.
+4 ; 2 - BIVAL (opt) Value/text of line (Null=blank line).
+5 ;
+6 IF '$DATA(BILINE)
QUIT
+7 DO WL^BIW(.BILINE,"BIVGRP",$GET(BIVAL),$GET(BIBLNK),$GET(BIENT))
+8 QUIT
+9 ;
+10 ;
+11 ;----------
EDIT ;EP
+1 ;---> Edit a Vaccine.
+2 ;---> Call the Listmanager Generic Selector of items displayed.
+3 NEW VALMY
+4 DO EN^VALM2(XQORNOD(0),"OS")
+5 ;
+6 ;---> Check that a Listman Item was passed.
+7 IF '$DATA(VALMY)
DO ERRCD^BIUTL2(406,,1)
DO RESET
QUIT
+8 ;---> Now set Y=Item# selected from the list.
+9 NEW Y
SET Y=$ORDER(VALMY(0))
+10 IF '$GET(Y)
DO ERRCD^BIUTL2(406,,1)
DO RESET
QUIT
+11 IF $GET(BIVAC(Y))=""
DO ERRCD^BIUTL2(510,,1)
DO RESET
QUIT
+12 NEW BIDA
SET BIDA=+BIVAC(Y)
+13 IF $GET(^BISERT(BIDA,0))=""
DO ERRCD^BIUTL2(510,,1)
DO RESET
QUIT
+14 ;
+15 ;---> Save previous setting of Forecast Yes/No (0=YES,1=NO).
+16 NEW BIFORC
SET BIFORC=$PIECE(^BISERT(BIDA,0),U,5)
+17 Begin DoDot:1
+18 IF BIFORC=1
SET $PIECE(^BISERT(BIDA,0),U,5)=0
QUIT
+19 SET $PIECE(^BISERT(BIDA,0),U,5)=1
End DoDot:1
+20 DO RESET
+21 QUIT
+22 ;
+23 ;
+24 ;----------
DISPLAY ;EP
+1 IF $GET(BIPOP)
DO FULL^VALM1
DO RESET
QUIT
+2 ;
+3 ;---> *** THE FOLLOWING CODE COULD BE USED TO DISPLAY WHICH VACCINES ARE
+4 ;---> AFFECTED BY TURNING ON/OFF A VACCINE GROUP. NOT USED FOR NOW. ***
+5 Begin DoDot:1
+6 QUIT
+7 ;
+8 NEW BINF
DO CONTRHL7^BIUTL11(BIDA,.BINF)
+9 IF '$DATA(BINF)
QUIT
+10 ;
+11 NEW N,BIHDR
SET N=0
+12 FOR
SET N=$ORDER(BINF(N))
IF 'N
QUIT
Begin DoDot:2
+13 NEW BIIEN
SET BIIEN=$$HL7TX^BIUTL2(N)
+14 IF 'BIIEN
QUIT
+15 IF BIIEN=BIDA
QUIT
+16 IF '$GET(BIHDR)
Begin DoDot:3
+17 WRITE !!?5,"The following related Vaccines will also change:"
+18 WRITE !!?5,"VACCINE FORECAST",!?5,"-----------------------"
End DoDot:3
SET BIHDR=1
+19 SET $PIECE(^AUTTIMM(BIIEN,0),U,16)=BIFORC1
+20 WRITE !?5,$$VNAME^BIUTL2(BIIEN),?20,$SELECT(BIFORC1:"NO",1:"YES")
End DoDot:2
End DoDot:1
+21 ;
+22 DO DIRZ^BIUTL3()
+23 DO FULL^VALM1
+24 DO RESET
+25 QUIT
+26 ;
+27 ;
+28 ;----------
RESET ;EP
+1 ;---> Update partition for return to Listmanager.
+2 IF $DATA(VALMQUIT)
SET VALMBCK="Q"
QUIT
+3 DO TERM^VALM0
SET VALMBCK="R"
+4 DO INIT^BIVGRP
DO HDR^BIVGRP()
+5 QUIT
