Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BIELIG1

BIELIG1.m

Go to the documentation of this file.
  1. BIELIG1 ;IHS/CMI/MWR - EDIT ELIGIBILITY CODES.; MAY 10, 2010
  1. ;;8.5;IMMUNIZATION;**3**;SEP 10,2012
  1. ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1. ;; EDIT ELIG CODE FIELDS: ACTIVE, LOCAL LABEL/TEXT, REPORT ABBREV.
  1. ;; PATCH 3: This entire routine to edit Eligibility Codes is new.
  1. ;
  1. ;
  1. ;----------
  1. INIT ;EP
  1. ;---> Initialize variables and list array.
  1. ;
  1. S VALMSG="Enter ?? for more actions."
  1. S VALM("TITLE")=$$LMVER^BILOGO
  1. ;
  1. ;---> Build Listmanager array.
  1. K ^TMP("BIELIG",$J),BIVAC
  1. ;
  1. N BILINE,BIENT,BIN,BIELIG1,I
  1. S BILINE=0,BIENT=0,BIN=0
  1. ;
  1. ;---> Use this code for selection of xrefs or see rtn BILOT1 code.
  1. ;D
  1. ;.I '$D(BICVXD) S BIXREF="B" Q
  1. ;.S BIXREF="C"
  1. ;
  1. N BIA
  1. F BIA=0,1 D
  1. .N BIN S BIN=0
  1. .F S BIN=$O(^BIELIG("AC",BIA,BIN)) Q:BIN="" D
  1. ..N BI0,BIIEN,X,Y
  1. ..S BIIEN=$O(^BIELIG("AC",BIA,BIN,0))
  1. ..Q:$D(BIELIG1(BIIEN))
  1. ..S BIELIG1(BIIEN)="",BI0=^BIELIG(BIIEN,0)
  1. ..;
  1. ..;---> Set Item# and build Item# array=IEN of Vaccine.
  1. ..S BIENT=BIENT+1,BIELIG(BIENT)=BIIEN
  1. ..;
  1. ..;---> Item#.
  1. ..S X=" "_BIENT_$S(BIENT<10:" ",BIENT<100:" ",1:" ")
  1. ..;
  1. ..;---> Code.
  1. ..S X=X_$P(BI0,U,1)
  1. ..S X=$$PAD^BIUTL5(X,15,".")
  1. ..;
  1. ..;---> Label of Code.
  1. ..S X=X_$E($P(BI0,U,2),1,21)
  1. ..S X=$$PAD^BIUTL5(X,38,".")
  1. ..;
  1. ..;---> Active/Inactive.
  1. ..S X=X_$S($P(BI0,U,3)=1:"Inactive",1:"Active")
  1. ..S X=$$PAD^BIUTL5(X,48,".")
  1. ..;
  1. ..;---> Local Text.
  1. ..S X=X_$E($P(BI0,U,4),1,20)
  1. ..S X=$$PAD^BIUTL5(X,70,".")
  1. ..;
  1. ..;---> Forecast On/Off.
  1. ..S X=X_$P(BI0,U,5)
  1. ..;
  1. ..;---> Set this Vaccine display row and index in ^TMP.
  1. ..D WRITE(.BILINE,X,,BIENT)
  1. ..;D WRITE(.BILINE,,,BIENT)
  1. ;
  1. ;---> Finish up Listmanager List Count.
  1. S VALMCNT=BILINE
  1. I VALMCNT>12 D
  1. .S VALMSG="Scroll down to view more. Type ?? for more actions."
  1. Q
  1. ;
  1. ;
  1. ;----------
  1. WRITE(BILINE,BIVAL,BIBLNK,BIENT) ;EP
  1. ;---> Write lines to ^TMP (see documentation in ^BIW).
  1. ;---> Parameters:
  1. ; 1 - BILINE (ret) Last line# written.
  1. ; 2 - BIVAL (opt) Value/text of line (Null=blank line).
  1. ;
  1. Q:'$D(BILINE)
  1. D WL^BIW(.BILINE,"BIELIG",$G(BIVAL),$G(BIBLNK),$G(BIENT))
  1. Q
  1. ;
  1. ;
  1. ;----------
  1. EDIT ;EP
  1. ;---> Edit an Eligibility Code.
  1. ;---> Called by Protocol: BI ELIGIBILITY CODE EDIT.
  1. ;---> Call the Listmanager Generic Selector of items displayed.
  1. N VALMY
  1. D EN^VALM2(XQORNOD(0),"OS")
  1. ;
  1. ;---> Check that a Listman Item was passed.
  1. I '$D(VALMY) D ERRCD^BIUTL2(406,,1) D RESET Q
  1. ;---> Now set Y=Item# selected from the list.
  1. N Y S Y=$O(VALMY(0))
  1. I '$G(Y) D ERRCD^BIUTL2(406,,1) D RESET Q
  1. I $G(BIELIG(Y))="" D ERRCD^BIUTL2(514,,1) D RESET Q
  1. N BIDA S BIDA=+BIELIG(Y)
  1. I $G(^BIELIG(BIDA,0))="" D ERRCD^BIUTL2(514,,1) D RESET Q
  1. ;---> Use next line and called code if you want to use Screenman.
  1. ;D EDITSCR(BIDA)
  1. D EDITFM(BIDA)
  1. D FULL^VALM1
  1. D RESET
  1. Q
  1. ;
  1. ;
  1. ;----------
  1. EDITFM(BIELIG) ;EP
  1. ;---> Edit the fields of am Eligibility Code by Fileman.
  1. ;---> Parameters:
  1. ; 1 - BIELIG (req) Eligibility Code IEN.
  1. ;
  1. ;---> Check that IEN of Elig Code is present.
  1. I '$G(BIELIG) D ERRCD^BIUTL2(514,,1) Q
  1. N Y S Y=^BIELIG(BIELIG,0)
  1. D TITLE^BIUTL5("EDIT ELIGIBILITY CODE")
  1. W !?5," Elig Code: ",$P(Y,U)
  1. W !?5," Code Label/Text: ",$P(Y,U,2)
  1. W !?5," Active Status: ",$S($P(Y,U,3):"Inactive",1:"Active")
  1. W !?5," Local Text: ",$P(Y,U,4)
  1. W !?5,"Report Abbreviation: ",$P(Y,U,5),!!!
  1. ;
  1. S DR=".03;.04;.05"
  1. D DIE^BIFMAN(9002084.83,DR,+BIELIG,.BIPOP)
  1. Q
  1. ;
  1. ;
  1. ;----------
  1. EDITSCR(BIVAC) ;EP
  1. ;---> Edit the fields of a vaccine.
  1. ;---> Parameters:
  1. ; 1 - BIVAC (req) Vaccine IEN.
  1. ;
  1. ;---> Check that IEN of vaccine is present.
  1. I '$G(BIVAC) D ERRCD^BIUTL2(441,,1) Q
  1. N Y S Y=^BIELIG(BIVAC,0)
  1. N BI
  1. S BI("A")=$P(Y,U,4) ;Default Lot Number IEN.
  1. S BI("B")=$P(Y,U,7) ;Active/Inactive.
  1. S BI("C")=$P(Y,U,13) ;VIS Default Date.
  1. S BI("D")=$P(Y,U,18) ;Default Volume.
  1. ;
  1. ;---> Call Screenman to build BI local array of data by user.
  1. N BISAVE
  1. N DR S DR="[BI FORM-VACCINE EDIT]"
  1. D DDS^BIFMAN(9999999.14,DR,BIVAC,"S",.BISAVE,.BIPOP)
  1. ;
  1. ;---> If user saved data, call ^BIUTL7 to save it.
  1. Q:('$G(BISAVE))
  1. ;
  1. ;---> Update data for this vaccine. (Make this an RPC in the future?)
  1. ;---> Add contraindication with a reason of Immune Deficiency.
  1. N BIERR,BIFLD
  1. S BIFLD(.04)=BI("A"),BIFLD(.07)=BI("B")
  1. S BIFLD(.13)=BI("C"),BIFLD(.18)=BI("D")
  1. D FDIE^BIFMAN(9999999.14,BIVAC,.BIFLD,.BIERR)
  1. ;
  1. ;---> If there was an error, display it.
  1. D:$G(BIERR)]""
  1. .D CLEAR^VALM1,FULL^VALM1,TITLE^BIUTL5("EDIT VACCINE FIELDS")
  1. .W !!?3,BIERR D DIRZ^BIUTL3()
  1. ;
  1. Q
  1. ;
  1. ;
  1. ;----------
  1. LOADVAC ;EP
  1. ;---> Code to load Vaccine data for ScreenMan Edit form.
  1. ;---> Called by Pre Action of Block BI BLK-VACCINE EDIT on
  1. ;---> Form BI FORM-VACCINE EDIT.
  1. ;
  1. ;---> Load Parent/Guardian.
  1. I $G(BI("A"))]"" D PUT^DDSVALF(1,,,BI("A"),"I")
  1. ;
  1. ;---> Load Active status.
  1. I $G(BI("B"))]"" D PUT^DDSVALF(2,,,BI("B"),"I")
  1. ;
  1. ;---> Load VIS Default Date.
  1. I $G(BI("C"))]"" D PUT^DDSVALF(3,,,BI("C"),"I")
  1. ;
  1. ;---> Load Mother's HBsAG Status.
  1. I $G(BI("D"))]"" D PUT^DDSVALF(4,,,BI("D"),"I")
  1. ;
  1. Q
  1. ;
  1. ;
  1. ;----------
  1. RESET ;EP
  1. ;---> Update partition for return to Listmanager.
  1. I $D(VALMQUIT) S VALMBCK="Q" Q
  1. D TERM^VALM0 S VALMBCK="R"
  1. D INIT^BIELIG,HDR^BIELIG()
  1. Q
  1. ;
  1. ;
  1. ;----------
  1. CHGORDR ;EP
  1. ;---> Change order of display of Vaccine Table (by Short Name or CVX).
  1. D
  1. .I '$D(BICVXD) S BICVXD="" Q
  1. .K BICVXD
  1. D RESET
  1. Q