- 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