BIVACED1 ;IHS/CMI/MWR - EDIT VACCINES.; MAY 10, 2010
;;8.5;IMMUNIZATION;**5**;JUL 01,2013
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; EDIT VACCINE FIELDS: CURRENT LOT, ACTIVE, VIS DATE DEFAULT.
;; PATCH 1: Comment out unnecessary forecast check. EDIT+34
;; PATCH 5: Display leading zero if default volume is less than 1. INIT+53
;
;
;----------
INIT ;EP
;---> Initialize variables and list array.
;
S VALMSG="Enter ?? for more actions."
S VALM("TITLE")=$$LMVER^BILOGO
;
;---> Build Listmanager array.
K ^TMP("BILMVA",$J),BIVAC
;
N BILINE,BIENT,BIN,BIVAC1,I
S BILINE=0,BIENT=0,BIN=0
D
.;I '$D(BICVXD) S BIXREF="AC" Q
.I '$D(BICVXD) S BIXREF="U" Q
.S BIXREF="C"
;
F S BIN=$O(^AUTTIMM(BIXREF,BIN)) Q:BIN="" D
.N BI0,BIIEN,X,Y
.S BIIEN=$O(^AUTTIMM(BIXREF,BIN,0))
.Q:$D(BIVAC1(BIIEN))
.S BIVAC1(BIIEN)="",BI0=^AUTTIMM(BIIEN,0)
.;
.;---> 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,2)
.S X=$$PAD^BIUTL5(X,17,".")
.;
.;---> HL7 Code.
.S X=X_"("_$P(BI0,U,3)_")"
.S X=$$PAD^BIUTL5(X,24,".")
.;
.;---> Active/Inactive.
.S X=X_$S($P(BI0,U,7)=1:"Inactive",$P(BI0,U,7)=0:"Active",1:"")
.;
.;---> Default Lot#.
.D:$P(BI0,U,4)
..S X=$$PAD^BIUTL5(X,35,".")
..S X=X_$$LOTTX^BIUTL6($P(BI0,U,4))
.;
.;---> VIS Default Date.
.D:$P(BI0,U,13)
..S X=$$PAD^BIUTL5(X,50,".")
..S X=X_$$SLDT2^BIUTL5($P(BI0,U,13),1)
.;
.;---> Volume Default.
.D:$P(BI0,U,18)
..S X=$$PAD^BIUTL5(X,60,".")
..;
..;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
..;---> Display leading zero if default volume is less than 1.
..N Y S Y=$P(BI0,U,18) S:(Y<1) Y="0"_Y
..S X=X_" "_Y_" ml "
..;S X=X_" "_$P(BI0,U,18)_" ml "
..;**********
.;
.;---> Forecast On/Off.
.S X=$$PAD^BIUTL5(X,72,".")
.S X=X_$S($$IMMVG^BIUTL2(BIIEN,3):"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,"BILMVA",$G(BIVAL),$G(BIBLNK),$G(BIENT))
Q
;
;
;----------
EDIT ;EP
;---> Edit a Vaccine.
;---> Steps:
; 1) This entry point is called by the Protocol:
; BI VACCINE EDIT, an action on the
; List Manager menu protocol: BI MENU VACCINE EDIT.
;
; 2) This code calls ScreenMan form:
; BI FORM-VACCINE EDIT to build BI local array
; of data for add/edit of a Vaccine.
; Data already stored in the BI local array is loaded
; into the form by LOADVAC^BIVACED1, which is called
; by the Pre-Action of Block for Vaccine Edit.
;
; 3) Use BI local array to send data to FDIE^BIFMAN.
;
;---> 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(502,,1) D RESET Q
N BIDA S BIDA=+BIVAC(Y)
I $G(^AUTTIMM(BIDA,0))="" D ERRCD^BIUTL2(502,,1) D RESET Q
D EDITSCR(BIDA)
D FULL^VALM1
D RESET
Q
;
;
;----------
EDITSCR(BIVAC) ;EP
;---> Edit the fields of a vaccine.
;---> Parameters:
; 1 - BIVAC (req) Vaccine IEN.
;
;---> Check that IEN of vaccine is present.
I '$G(BIVAC) D ERRCD^BIUTL2(441,,1) Q
N Y S Y=^AUTTIMM(BIVAC,0)
N BI
S BI("A")=$P(Y,U,4) ;Default Lot Number IEN.
S BI("B")=$P(Y,U,7) ;Active/Inactive.
S BI("C")=$P(Y,U,13) ;VIS Default Date.
S BI("D")=$P(Y,U,18) ;Default Volume.
;
;---> Call Screenman to build BI local array of data by user.
N BISAVE
N DR S DR="[BI FORM-VACCINE EDIT]"
D DDS^BIFMAN(9999999.14,DR,BIVAC,"S",.BISAVE,.BIPOP)
;
;---> If user saved data, call ^BIUTL7 to save it.
Q:('$G(BISAVE))
;
;---> Update data for this vaccine. (Make this an RPC in the future?)
;---> Add contraindication with a reason of Immune Deficiency.
N BIERR,BIFLD
S BIFLD(.04)=BI("A"),BIFLD(.07)=BI("B")
S BIFLD(.13)=BI("C"),BIFLD(.18)=BI("D")
D FDIE^BIFMAN(9999999.14,BIVAC,.BIFLD,.BIERR)
;
;---> If there was an error, display it.
D:$G(BIERR)]""
.D CLEAR^VALM1,FULL^VALM1,TITLE^BIUTL5("EDIT VACCINE FIELDS")
.W !!?3,BIERR D DIRZ^BIUTL3()
;
Q
;
;
;----------
LOADVAC ;EP
;---> Code to load Vaccine data for ScreenMan Edit form.
;---> Called by Pre Action of Block BI BLK-VACCINE EDIT on
;---> Form BI FORM-VACCINE EDIT.
;
;---> Load Parent/Guardian.
I $G(BI("A"))]"" D PUT^DDSVALF(1,,,BI("A"),"I")
;
;---> Load Active status.
I $G(BI("B"))]"" D PUT^DDSVALF(2,,,BI("B"),"I")
;
;---> Load VIS Default Date.
I $G(BI("C"))]"" D PUT^DDSVALF(3,,,BI("C"),"I")
;
;---> Load Mother's HBsAG Status.
I $G(BI("D"))]"" D PUT^DDSVALF(4,,,BI("D"),"I")
;
Q
;
;
;----------
RESET ;EP
;---> Update partition for return to Listmanager.
I $D(VALMQUIT) S VALMBCK="Q" Q
D TERM^VALM0 S VALMBCK="R"
D INIT^BIVACED,HDR^BIVACED()
Q
;
;
;----------
CHGORDR ;EP
;---> Change order of display of Vaccine Table (by Short Name or CVX).
D
.I '$D(BICVXD) S BICVXD="" Q
.K BICVXD
D RESET
Q
BIVACED1 ;IHS/CMI/MWR - EDIT VACCINES.; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**5**;JUL 01,2013
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; EDIT VACCINE FIELDS: CURRENT LOT, ACTIVE, VIS DATE DEFAULT.
+4 ;; PATCH 1: Comment out unnecessary forecast check. EDIT+34
+5 ;; PATCH 5: Display leading zero if default volume is less than 1. INIT+53
+6 ;
+7 ;
+8 ;----------
INIT ;EP
+1 ;---> Initialize variables and list array.
+2 ;
+3 SET VALMSG="Enter ?? for more actions."
+4 SET VALM("TITLE")=$$LMVER^BILOGO
+5 ;
+6 ;---> Build Listmanager array.
+7 KILL ^TMP("BILMVA",$JOB),BIVAC
+8 ;
+9 NEW BILINE,BIENT,BIN,BIVAC1,I
+10 SET BILINE=0
SET BIENT=0
SET BIN=0
+11 Begin DoDot:1
+12 ;I '$D(BICVXD) S BIXREF="AC" Q
+13 IF '$DATA(BICVXD)
SET BIXREF="U"
QUIT
+14 SET BIXREF="C"
End DoDot:1
+15 ;
+16 FOR
SET BIN=$ORDER(^AUTTIMM(BIXREF,BIN))
IF BIN=""
QUIT
Begin DoDot:1
+17 NEW BI0,BIIEN,X,Y
+18 SET BIIEN=$ORDER(^AUTTIMM(BIXREF,BIN,0))
+19 IF $DATA(BIVAC1(BIIEN))
QUIT
+20 SET BIVAC1(BIIEN)=""
SET BI0=^AUTTIMM(BIIEN,0)
+21 ;
+22 ;---> Set Item# and build Item# array=IEN of Vaccine.
+23 SET BIENT=BIENT+1
SET BIVAC(BIENT)=BIIEN
+24 ;
+25 ;---> Item#.
+26 SET X=" "_$SELECT(BIENT<10:" "_BIENT,1:BIENT)
+27 ;
+28 ;---> Vaccine (Short) Name.
+29 SET X=X_" "_$PIECE(BI0,U,2)
+30 SET X=$$PAD^BIUTL5(X,17,".")
+31 ;
+32 ;---> HL7 Code.
+33 SET X=X_"("_$PIECE(BI0,U,3)_")"
+34 SET X=$$PAD^BIUTL5(X,24,".")
+35 ;
+36 ;---> Active/Inactive.
+37 SET X=X_$SELECT($PIECE(BI0,U,7)=1:"Inactive",$PIECE(BI0,U,7)=0:"Active",1:"")
+38 ;
+39 ;---> Default Lot#.
+40 IF $PIECE(BI0,U,4)
Begin DoDot:2
+41 SET X=$$PAD^BIUTL5(X,35,".")
+42 SET X=X_$$LOTTX^BIUTL6($PIECE(BI0,U,4))
End DoDot:2
+43 ;
+44 ;---> VIS Default Date.
+45 IF $PIECE(BI0,U,13)
Begin DoDot:2
+46 SET X=$$PAD^BIUTL5(X,50,".")
+47 SET X=X_$$SLDT2^BIUTL5($PIECE(BI0,U,13),1)
End DoDot:2
+48 ;
+49 ;---> Volume Default.
+50 IF $PIECE(BI0,U,18)
Begin DoDot:2
+51 SET X=$$PAD^BIUTL5(X,60,".")
+52 ;
+53 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+54 ;---> Display leading zero if default volume is less than 1.
+55 NEW Y
SET Y=$PIECE(BI0,U,18)
IF (Y<1)
SET Y="0"_Y
+56 SET X=X_" "_Y_" ml "
+57 ;S X=X_" "_$P(BI0,U,18)_" ml "
+58 ;**********
End DoDot:2
+59 ;
+60 ;---> Forecast On/Off.
+61 SET X=$$PAD^BIUTL5(X,72,".")
+62 SET X=X_$SELECT($$IMMVG^BIUTL2(BIIEN,3):"YES",1:"NO")
+63 ;
+64 ;---> Set this Vaccine display row and index in ^TMP.
+65 DO WRITE(.BILINE,X,,BIENT)
+66 ;D WRITE(.BILINE,,,BIENT)
End DoDot:1
+67 ;
+68 ;---> Finish up Listmanager List Count.
+69 SET VALMCNT=BILINE
+70 IF VALMCNT>12
Begin DoDot:1
+71 SET VALMSG="Scroll down to view more. Type ?? for more actions."
End DoDot:1
+72 QUIT
+73 ;
+74 ;
+75 ;----------
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,"BILMVA",$GET(BIVAL),$GET(BIBLNK),$GET(BIENT))
+8 QUIT
+9 ;
+10 ;
+11 ;----------
EDIT ;EP
+1 ;---> Edit a Vaccine.
+2 ;---> Steps:
+3 ; 1) This entry point is called by the Protocol:
+4 ; BI VACCINE EDIT, an action on the
+5 ; List Manager menu protocol: BI MENU VACCINE EDIT.
+6 ;
+7 ; 2) This code calls ScreenMan form:
+8 ; BI FORM-VACCINE EDIT to build BI local array
+9 ; of data for add/edit of a Vaccine.
+10 ; Data already stored in the BI local array is loaded
+11 ; into the form by LOADVAC^BIVACED1, which is called
+12 ; by the Pre-Action of Block for Vaccine Edit.
+13 ;
+14 ; 3) Use BI local array to send data to FDIE^BIFMAN.
+15 ;
+16 ;---> Call the Listmanager Generic Selector of items displayed.
+17 NEW VALMY
+18 DO EN^VALM2(XQORNOD(0),"OS")
+19 ;
+20 ;---> Check that a Listman Item was passed.
+21 IF '$DATA(VALMY)
DO ERRCD^BIUTL2(406,,1)
DO RESET
QUIT
+22 ;---> Now set Y=Item# selected from the list.
+23 NEW Y
SET Y=$ORDER(VALMY(0))
+24 IF '$GET(Y)
DO ERRCD^BIUTL2(406,,1)
DO RESET
QUIT
+25 IF $GET(BIVAC(Y))=""
DO ERRCD^BIUTL2(502,,1)
DO RESET
QUIT
+26 NEW BIDA
SET BIDA=+BIVAC(Y)
+27 IF $GET(^AUTTIMM(BIDA,0))=""
DO ERRCD^BIUTL2(502,,1)
DO RESET
QUIT
+28 DO EDITSCR(BIDA)
+29 DO FULL^VALM1
+30 DO RESET
+31 QUIT
+32 ;
+33 ;
+34 ;----------
EDITSCR(BIVAC) ;EP
+1 ;---> Edit the fields of a vaccine.
+2 ;---> Parameters:
+3 ; 1 - BIVAC (req) Vaccine IEN.
+4 ;
+5 ;---> Check that IEN of vaccine is present.
+6 IF '$GET(BIVAC)
DO ERRCD^BIUTL2(441,,1)
QUIT
+7 NEW Y
SET Y=^AUTTIMM(BIVAC,0)
+8 NEW BI
+9 ;Default Lot Number IEN.
SET BI("A")=$PIECE(Y,U,4)
+10 ;Active/Inactive.
SET BI("B")=$PIECE(Y,U,7)
+11 ;VIS Default Date.
SET BI("C")=$PIECE(Y,U,13)
+12 ;Default Volume.
SET BI("D")=$PIECE(Y,U,18)
+13 ;
+14 ;---> Call Screenman to build BI local array of data by user.
+15 NEW BISAVE
+16 NEW DR
SET DR="[BI FORM-VACCINE EDIT]"
+17 DO DDS^BIFMAN(9999999.14,DR,BIVAC,"S",.BISAVE,.BIPOP)
+18 ;
+19 ;---> If user saved data, call ^BIUTL7 to save it.
+20 IF ('$GET(BISAVE))
QUIT
+21 ;
+22 ;---> Update data for this vaccine. (Make this an RPC in the future?)
+23 ;---> Add contraindication with a reason of Immune Deficiency.
+24 NEW BIERR,BIFLD
+25 SET BIFLD(.04)=BI("A")
SET BIFLD(.07)=BI("B")
+26 SET BIFLD(.13)=BI("C")
SET BIFLD(.18)=BI("D")
+27 DO FDIE^BIFMAN(9999999.14,BIVAC,.BIFLD,.BIERR)
+28 ;
+29 ;---> If there was an error, display it.
+30 IF $GET(BIERR)]""
Begin DoDot:1
+31 DO CLEAR^VALM1
DO FULL^VALM1
DO TITLE^BIUTL5("EDIT VACCINE FIELDS")
+32 WRITE !!?3,BIERR
DO DIRZ^BIUTL3()
End DoDot:1
+33 ;
+34 QUIT
+35 ;
+36 ;
+37 ;----------
LOADVAC ;EP
+1 ;---> Code to load Vaccine data for ScreenMan Edit form.
+2 ;---> Called by Pre Action of Block BI BLK-VACCINE EDIT on
+3 ;---> Form BI FORM-VACCINE EDIT.
+4 ;
+5 ;---> Load Parent/Guardian.
+6 IF $GET(BI("A"))]""
DO PUT^DDSVALF(1,,,BI("A"),"I")
+7 ;
+8 ;---> Load Active status.
+9 IF $GET(BI("B"))]""
DO PUT^DDSVALF(2,,,BI("B"),"I")
+10 ;
+11 ;---> Load VIS Default Date.
+12 IF $GET(BI("C"))]""
DO PUT^DDSVALF(3,,,BI("C"),"I")
+13 ;
+14 ;---> Load Mother's HBsAG Status.
+15 IF $GET(BI("D"))]""
DO PUT^DDSVALF(4,,,BI("D"),"I")
+16 ;
+17 QUIT
+18 ;
+19 ;
+20 ;----------
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^BIVACED
DO HDR^BIVACED()
+5 QUIT
+6 ;
+7 ;
+8 ;----------
CHGORDR ;EP
+1 ;---> Change order of display of Vaccine Table (by Short Name or CVX).
+2 Begin DoDot:1
+3 IF '$DATA(BICVXD)
SET BICVXD=""
QUIT
+4 KILL BICVXD
End DoDot:1
+5 DO RESET
+6 QUIT
