BIELIG1 ;IHS/CMI/MWR - EDIT ELIGIBILITY CODES.; MAY 10, 2010
;;8.5;IMMUNIZATION;**3**;SEP 10,2012
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; EDIT ELIG CODE FIELDS: ACTIVE, LOCAL LABEL/TEXT, REPORT ABBREV.
;; PATCH 3: This entire routine to edit Eligibility Codes is new.
;
;
;----------
INIT ;EP
;---> Initialize variables and list array.
;
S VALMSG="Enter ?? for more actions."
S VALM("TITLE")=$$LMVER^BILOGO
;
;---> Build Listmanager array.
K ^TMP("BIELIG",$J),BIVAC
;
N BILINE,BIENT,BIN,BIELIG1,I
S BILINE=0,BIENT=0,BIN=0
;
;---> Use this code for selection of xrefs or see rtn BILOT1 code.
;D
;.I '$D(BICVXD) S BIXREF="B" Q
;.S BIXREF="C"
;
N BIA
F BIA=0,1 D
.N BIN S BIN=0
.F S BIN=$O(^BIELIG("AC",BIA,BIN)) Q:BIN="" D
..N BI0,BIIEN,X,Y
..S BIIEN=$O(^BIELIG("AC",BIA,BIN,0))
..Q:$D(BIELIG1(BIIEN))
..S BIELIG1(BIIEN)="",BI0=^BIELIG(BIIEN,0)
..;
..;---> Set Item# and build Item# array=IEN of Vaccine.
..S BIENT=BIENT+1,BIELIG(BIENT)=BIIEN
..;
..;---> Item#.
..S X=" "_BIENT_$S(BIENT<10:" ",BIENT<100:" ",1:" ")
..;
..;---> Code.
..S X=X_$P(BI0,U,1)
..S X=$$PAD^BIUTL5(X,15,".")
..;
..;---> Label of Code.
..S X=X_$E($P(BI0,U,2),1,21)
..S X=$$PAD^BIUTL5(X,38,".")
..;
..;---> Active/Inactive.
..S X=X_$S($P(BI0,U,3)=1:"Inactive",1:"Active")
..S X=$$PAD^BIUTL5(X,48,".")
..;
..;---> Local Text.
..S X=X_$E($P(BI0,U,4),1,20)
..S X=$$PAD^BIUTL5(X,70,".")
..;
..;---> Forecast On/Off.
..S X=X_$P(BI0,U,5)
..;
..;---> 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,"BIELIG",$G(BIVAL),$G(BIBLNK),$G(BIENT))
Q
;
;
;----------
EDIT ;EP
;---> Edit an Eligibility Code.
;---> Called by Protocol: BI ELIGIBILITY CODE EDIT.
;---> 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(BIELIG(Y))="" D ERRCD^BIUTL2(514,,1) D RESET Q
N BIDA S BIDA=+BIELIG(Y)
I $G(^BIELIG(BIDA,0))="" D ERRCD^BIUTL2(514,,1) D RESET Q
;---> Use next line and called code if you want to use Screenman.
;D EDITSCR(BIDA)
D EDITFM(BIDA)
D FULL^VALM1
D RESET
Q
;
;
;----------
EDITFM(BIELIG) ;EP
;---> Edit the fields of am Eligibility Code by Fileman.
;---> Parameters:
; 1 - BIELIG (req) Eligibility Code IEN.
;
;---> Check that IEN of Elig Code is present.
I '$G(BIELIG) D ERRCD^BIUTL2(514,,1) Q
N Y S Y=^BIELIG(BIELIG,0)
D TITLE^BIUTL5("EDIT ELIGIBILITY CODE")
W !?5," Elig Code: ",$P(Y,U)
W !?5," Code Label/Text: ",$P(Y,U,2)
W !?5," Active Status: ",$S($P(Y,U,3):"Inactive",1:"Active")
W !?5," Local Text: ",$P(Y,U,4)
W !?5,"Report Abbreviation: ",$P(Y,U,5),!!!
;
S DR=".03;.04;.05"
D DIE^BIFMAN(9002084.83,DR,+BIELIG,.BIPOP)
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=^BIELIG(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^BIELIG,HDR^BIELIG()
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
BIELIG1 ;IHS/CMI/MWR - EDIT ELIGIBILITY CODES.; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**3**;SEP 10,2012
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; EDIT ELIG CODE FIELDS: ACTIVE, LOCAL LABEL/TEXT, REPORT ABBREV.
+4 ;; PATCH 3: This entire routine to edit Eligibility Codes is new.
+5 ;
+6 ;
+7 ;----------
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("BIELIG",$JOB),BIVAC
+8 ;
+9 NEW BILINE,BIENT,BIN,BIELIG1,I
+10 SET BILINE=0
SET BIENT=0
SET BIN=0
+11 ;
+12 ;---> Use this code for selection of xrefs or see rtn BILOT1 code.
+13 ;D
+14 ;.I '$D(BICVXD) S BIXREF="B" Q
+15 ;.S BIXREF="C"
+16 ;
+17 NEW BIA
+18 FOR BIA=0,1
Begin DoDot:1
+19 NEW BIN
SET BIN=0
+20 FOR
SET BIN=$ORDER(^BIELIG("AC",BIA,BIN))
IF BIN=""
QUIT
Begin DoDot:2
+21 NEW BI0,BIIEN,X,Y
+22 SET BIIEN=$ORDER(^BIELIG("AC",BIA,BIN,0))
+23 IF $DATA(BIELIG1(BIIEN))
QUIT
+24 SET BIELIG1(BIIEN)=""
SET BI0=^BIELIG(BIIEN,0)
+25 ;
+26 ;---> Set Item# and build Item# array=IEN of Vaccine.
+27 SET BIENT=BIENT+1
SET BIELIG(BIENT)=BIIEN
+28 ;
+29 ;---> Item#.
+30 SET X=" "_BIENT_$SELECT(BIENT<10:" ",BIENT<100:" ",1:" ")
+31 ;
+32 ;---> Code.
+33 SET X=X_$PIECE(BI0,U,1)
+34 SET X=$$PAD^BIUTL5(X,15,".")
+35 ;
+36 ;---> Label of Code.
+37 SET X=X_$EXTRACT($PIECE(BI0,U,2),1,21)
+38 SET X=$$PAD^BIUTL5(X,38,".")
+39 ;
+40 ;---> Active/Inactive.
+41 SET X=X_$SELECT($PIECE(BI0,U,3)=1:"Inactive",1:"Active")
+42 SET X=$$PAD^BIUTL5(X,48,".")
+43 ;
+44 ;---> Local Text.
+45 SET X=X_$EXTRACT($PIECE(BI0,U,4),1,20)
+46 SET X=$$PAD^BIUTL5(X,70,".")
+47 ;
+48 ;---> Forecast On/Off.
+49 SET X=X_$PIECE(BI0,U,5)
+50 ;
+51 ;---> Set this Vaccine display row and index in ^TMP.
+52 DO WRITE(.BILINE,X,,BIENT)
+53 ;D WRITE(.BILINE,,,BIENT)
End DoDot:2
End DoDot:1
+54 ;
+55 ;---> Finish up Listmanager List Count.
+56 SET VALMCNT=BILINE
+57 IF VALMCNT>12
Begin DoDot:1
+58 SET VALMSG="Scroll down to view more. Type ?? for more actions."
End DoDot:1
+59 QUIT
+60 ;
+61 ;
+62 ;----------
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,"BIELIG",$GET(BIVAL),$GET(BIBLNK),$GET(BIENT))
+8 QUIT
+9 ;
+10 ;
+11 ;----------
EDIT ;EP
+1 ;---> Edit an Eligibility Code.
+2 ;---> Called by Protocol: BI ELIGIBILITY CODE EDIT.
+3 ;---> Call the Listmanager Generic Selector of items displayed.
+4 NEW VALMY
+5 DO EN^VALM2(XQORNOD(0),"OS")
+6 ;
+7 ;---> Check that a Listman Item was passed.
+8 IF '$DATA(VALMY)
DO ERRCD^BIUTL2(406,,1)
DO RESET
QUIT
+9 ;---> Now set Y=Item# selected from the list.
+10 NEW Y
SET Y=$ORDER(VALMY(0))
+11 IF '$GET(Y)
DO ERRCD^BIUTL2(406,,1)
DO RESET
QUIT
+12 IF $GET(BIELIG(Y))=""
DO ERRCD^BIUTL2(514,,1)
DO RESET
QUIT
+13 NEW BIDA
SET BIDA=+BIELIG(Y)
+14 IF $GET(^BIELIG(BIDA,0))=""
DO ERRCD^BIUTL2(514,,1)
DO RESET
QUIT
+15 ;---> Use next line and called code if you want to use Screenman.
+16 ;D EDITSCR(BIDA)
+17 DO EDITFM(BIDA)
+18 DO FULL^VALM1
+19 DO RESET
+20 QUIT
+21 ;
+22 ;
+23 ;----------
EDITFM(BIELIG) ;EP
+1 ;---> Edit the fields of am Eligibility Code by Fileman.
+2 ;---> Parameters:
+3 ; 1 - BIELIG (req) Eligibility Code IEN.
+4 ;
+5 ;---> Check that IEN of Elig Code is present.
+6 IF '$GET(BIELIG)
DO ERRCD^BIUTL2(514,,1)
QUIT
+7 NEW Y
SET Y=^BIELIG(BIELIG,0)
+8 DO TITLE^BIUTL5("EDIT ELIGIBILITY CODE")
+9 WRITE !?5," Elig Code: ",$PIECE(Y,U)
+10 WRITE !?5," Code Label/Text: ",$PIECE(Y,U,2)
+11 WRITE !?5," Active Status: ",$SELECT($PIECE(Y,U,3):"Inactive",1:"Active")
+12 WRITE !?5," Local Text: ",$PIECE(Y,U,4)
+13 WRITE !?5,"Report Abbreviation: ",$PIECE(Y,U,5),!!!
+14 ;
+15 SET DR=".03;.04;.05"
+16 DO DIE^BIFMAN(9002084.83,DR,+BIELIG,.BIPOP)
+17 QUIT
+18 ;
+19 ;
+20 ;----------
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=^BIELIG(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^BIELIG
DO HDR^BIELIG()
+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
