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

BIFMAN.m

Go to the documentation of this file. 
  1. BIFMAN ;IHS/CMI/MWR - FILEMAN CALLS; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;;SEP 01,2011
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  CALLS TO FILEMAN WITH PRE- AND POST-CALL VARIABLE SETTING.
  1.  ;
  1.  ;
  1.  ;----------
  1. DIC(DIC,DIC0,BIY,DICA,DICB,DICS,BIX,BIPOP,DICDR) ;EP
  1.  ;---> CALL TO ^DIC - File lookup and/or add new entry.
  1.  ;---> Parameters:
  1.  ;     1 - DIC=DIC         (req)
  1.  ;     2 - DIC0=DIC(0)     (req)
  1.  ;     3 - BIY             (ret) Equal to Y from call to ^DIC.
  1.  ;     4 - DICA=DIC("A")   (opt) Prompt
  1.  ;     5 - DICB=DIC("B")   (opt) DEFAULT
  1.  ;     6 - DICS=DIC("S")   (opt) Screen
  1.  ;     7 - BIX             (opt) Equal to X if DIC(0)'["A".
  1.  ;     8 - BIPOP           (opt) BIPOP=1 if DTOUT or DUOUT
  1.  ;     9 - DICDR=DIC("DR") (opt) To specify fields to be asked when
  1.  ;                               adding a new entry.
  1.  ;
  1.  ;---> Example: D DIC^BIFMAN(9002086,"QEMAL",.Y,"   Select PATIENT: ")
  1.  ;              To stuff an entry:
  1.  ;              D DIC^BIFMAN(9002086,"QEML",.Y,,,,"NewEntry")
  1.  ;
  1.  N X,Y
  1.  S:$G(BIX)]"" X=BIX
  1.  I $G(DIC)']""!($G(DIC0)']"") S BIPOP=1 Q
  1.  S BIPOP=0 S:DIC DLAYGO=$P(DIC,".")
  1.  S DIC(0)=DIC0
  1.  S:$G(DICA)]"" DIC("A")=DICA
  1.  S:$G(DICB)]"" DIC("B")=DICB
  1.  S:$G(DICDR)]"" DIC("DR")=DICDR
  1.  S:$G(DICS)]"" DIC("S")=DICS
  1.  D ^DIC
  1.  S BIY=Y
  1.  S:($D(DTOUT))!($D(DUOUT)) BIPOP=1
  1.  D DKILLS
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. UPDATE(BIFN,BIIEN,BIFLD,BIERR,BIEXT) ;EP
  1.  ;---> CALL TO UPDATE^DIE - To *ADD* new entry or subentry to a file.
  1.  ;---> Parameters:
  1.  ;     1 - BIFN   (req) File Number.
  1.  ;     2 - BIIEN  (opt) IENS Array setting Seq Number=desire IEN in global.
  1.  ;     3 - BIFLD  (req) Array of BIFLD(Field#)=Value, esp. need a .01 node,
  1.  ;                      may need other required fields.
  1.  ;     4 - BIERR  (ret) Text of error, if any.
  1.  ;     5 - BIEXT  (opt) If BIEXT="E", tell UPDATE^DIE values are External.
  1.  ;
  1.  ;---> Example:  N BIERR,BIFLD,BIIEN
  1.  ;               S BIIEN(1)=777  (This is to S DINUM=X; specify IEN in global)
  1.  ;               S BIFLD(.01)=777
  1.  ;               S BIFLD(.02)="This is a test of UPDATE~DIE."
  1.  ;               D UPDATE^BIFMAN(9002084.33,.BIIEN,.BIFLD,.BIERR)
  1.  ;               I $G(BIERR)]"" W !!?3,BIERR D DIRZ^BIUTL3()
  1.  ;            OR
  1.  ;               NOTE!: 2nd Parameter, BIIEN, is optional;
  1.  ;                      But you must set BIFLD(.01)=something.
  1.  ;               N BIERR,BIFLD
  1.  ;               S BIFLD(.01)=BIDFN,BIFLD(.02)=BIPTR,BIFLD(.03)=BIREAS
  1.  ;               D UPDATE^BIFMAN(9002084.11,,.BIFLD,.BIERR)
  1.  ;
  1.  N BIFDA,BIMSG,BISEQN
  1.  ;
  1.  ;---Check for valid File Number and Data Dictionary.
  1.  I '$G(BIFN) D ERRCD^BIUTL2(671,.BIERR) Q
  1.  I '$D(^DD($G(BIFN),0)) D ERRCD^BIUTL2(671,.BIERR) Q
  1.  ;
  1.  ;---> Set BISEQN is Sequence Number #1 set to ADD new top level entry.
  1.  S BISEQN="+1,"
  1.  ;---> Process External/Internal Flag value.
  1.  S BIEXT=$S($G(BIEXT)=1:"E",1:"")
  1.  ;
  1.  ;---> Create FDA.
  1.  N N S N=0
  1.  F  S N=$O(BIFLD(N)) Q:'N  D
  1.  .S BIFDA(BIFN,BISEQN,N)=BIFLD(N)
  1.  ;
  1.  D UPDATE^DIE(BIEXT,"BIFDA","BIIEN","BIMSG")
  1.  ;
  1.  S BIERR=$G(BIMSG("DIERR",1,"TEXT",1))
  1.  I BIERR'="" S BIERR=BIERR_" (software error) #674"
  1.  D DKILLS
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DDS(DDSFILE,DR,DA,DDSPARM,DDSSAVE,BIPOP) ;EP
  1.  ;---> CALL TO ^DDS
  1.  ;---> NOTE: Screenman automatically uses incremental locks.
  1.  ;---> Parameters:
  1.  ;     1 - DDSFILE=FILE# (req)
  1.  ;     2 - DR=FORM       (req)
  1.  ;     3 - DA=RECORD     (req)
  1.  ;     4 - DDSPARM (C/E) (opt) C=Register change in DDSCHANG
  1.  ;     5 - DDSSAVE       (ret) $G(DDSSAVE)=1 if user saved changes.
  1.  ;     6 - BIPOP         (ret) FAIL/QUIT/TIMEOUT
  1.  ;
  1.  ;---> Examples:
  1.  ;     D DDS^BIFMAN(9002086.02,"[BI SITE PARAMS-FORM-1]",+Y)
  1.  ;     D DDS^BIFMAN(9002086.1,"[BI PROC-FORM-LAB]",DA,"C",.BICHG,.BIPOP)
  1.  ;
  1.  N BIDA,X,Y S BIDA=DA,BIPOP=0
  1.  I DDSFILE S DDSFILE=^DIC(DDSFILE,0,"GL")
  1.  I $G(BIDA) L +@(DDSFILE_BIDA_")"):5 I '$T S BIPOP=1 D LOCKED^BIUTL3 Q
  1.  K ^TMP("DDS",$J)
  1.  I '$D(IOST(0)) D HOME^%ZIS,ENS^%ZISS
  1.  D ^DDS
  1.  S:$D(DTOUT) BIPOP=1
  1.  I $D(DIMSG)!($D(DIERR)) D  S BIPOP=1
  1.  .W !?5,"* The Screen Manager could not edit this record."
  1.  .W !?7,"Please contact your Site Manager." D DIRZ^BIUTL3(.BIPOP)
  1.  I $G(BIDA) L -@(DDSFILE_BIDA_")")
  1.  D DKILLS
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DIE(DIE,DR,DA,BIPOP,Z) ;EP
  1.  ;---> CALL TO ^DIE - Edit entry in a file.
  1.  ;---> Parameters:
  1.  ;     1 - DIE=DIE (req)
  1.  ;     2 - DR=DR   (req)
  1.  ;     3 - DA=DA   (req)
  1.  ;     4 - BIPOP   (ret) BIPOP=1 indicates failure/quit
  1.  ;     5 - Z       (opt) Z=1 if user should *NOT* be notified
  1.  ;                            record was locked.
  1.  ;
  1.  ;---> Example: D DIE^BIFMAN(9002086,DR,+Y,.BIPOP)
  1.  ;              (+Y from DIC call, DR could be literal if short.)
  1.  ;
  1.  N BIDA,X,Y S BIDA=DA,BIPOP=0
  1.  I DIE S DIE=^DIC(DIE,0,"GL")
  1.  L +@(DIE_BIDA_")"):5 I '$T S BIPOP=1 D:'$G(Z) LOCKED^BIUTL3 Q
  1.  D ^DIE
  1.  S:($D(DTOUT))!($D(Y)) BIPOP=1
  1.  L -@(DIE_BIDA_")")
  1.  D DKILLS
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. FDIE(BIFN,BIIENS,BIFLD,BIERR,BIEXT) ;EP - Call to FILE^DIE.
  1.  ;---> CALL TO FILE^DIE - File validated data into an *EXISTING* entry in a file.
  1.  ;---> Parameters:
  1.  ;     1 - BIFN   (req) File Number.
  1.  ;     2 - BIIENS (req) IENS comma-delimited String.
  1.  ;     3 - BIFLD  (req) Array of BIFLD(Field#)=Value
  1.  ;     4 - BIERR  (ret) Text of error, if any.
  1.  ;     5 - BIEXT  (opt) If BIEXT=1, tell FILE^DIE values are External.
  1.  ;
  1.  ;---> Example:
  1.  ;---> Build FDA field=value array.
  1.  ;N BIFLD
  1.  ;S BIFLD(.08)=E
  1.  ;S BIFLD(.09)=C
  1.  ;S BIFLD(.1)=B
  1.  ;S BIFLD(.11)=D
  1.  ;
  1.  ;---> Store edit data.
  1.  ;---> Example: D FDIE^BIFMAN(9002084,+BIIEN,.BIFLD,.BIERR)
  1.  ;
  1.  ;
  1.  N BIDA,BIFDA,BIGBL,BIMSG
  1.  ;
  1.  ;---Check for valid File Number and Data Dictionary.
  1.  I '$G(BIFN) D ERRCD^BIUTL2(671,.BIERR) Q
  1.  I '$D(^DD($G(BIFN),0)) D ERRCD^BIUTL2(671,.BIERR) Q
  1.  ;
  1.  ;---> Check for valid IEN.
  1.  I '$G(BIIENS) D ERRCD^BIUTL2(672,.BIERR) Q
  1.  ;---> Append mandatory terminating comma to IENS if not present.
  1.  S:($E(BIIENS,$L(BIIENS))'=",") BIIENS=BIIENS_","
  1.  S BIDA=$P(BIIENS,",",($L(BIIENS,",")-1))
  1.  ;
  1.  ;---Check for valid global.
  1.  S BIGBL=$G(^DIC(BIFN,0,"GL"))
  1.  I BIGBL="" D ERRCD^BIUTL2(601,.BIERR) Q
  1.  ;
  1.  ;---> Check for existence of the top level entry to be edited.
  1.  I '$D(@(BIGBL_BIDA_",0)")) D ERRCD^BIUTL2(673,.BIERR) Q
  1.  ;
  1.  ;---> Lock entry or quit if unavailable.
  1.  L +@(BIGBL_BIDA_")"):5 I '$T D ERRCD^BIUTL2(670,.BIERR) Q
  1.  ;
  1.  ;---> Process External/Internal Flag value.
  1.  S BIEXT=$S($G(BIEXT)=1:"E",1:"")
  1.  ;
  1.  ;---> Create FDA.
  1.  N N S N=0
  1.  F  S N=$O(BIFLD(N)) Q:'N  D
  1.  .S BIFDA(BIFN,BIIENS,N)=BIFLD(N)
  1.  ;
  1.  D FILE^DIE(BIEXT,"BIFDA","BIMSG")
  1.  L -@(BIGBL_BIDA_")")
  1.  S BIERR=$G(BIMSG("DIERR",1,"TEXT",1))
  1.  I BIERR'="" S BIERR=$E(BIERR,1,($L(BIERR)-1))_" (software error). #674"
  1.  D DKILLS
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DIR(DIR0,Y,BIPOP,DIRA,DIRB,DIRQ,DIRQ1) ;EP
  1.  ;---> Call to ^DIR - General purpose reader, for prompts, etc.
  1.  ;---> Parameters:
  1.  ;     1 - DIR0=DIR(0)      (req) Indicate type of read
  1.  ;     2 - Y                (ret) From call to ^DIR
  1.  ;     3 - BIPOP            (ret) BIPOP=1 if DIRUT
  1.  ;     4 - DIRA=DIR("A")    (opt) Prompt
  1.  ;     5 - DIRB=DIR("B")    (opt) Default
  1.  ;     6 - DIRQ=DIR("?")    (opt) Help
  1.  ;     7 - DIRQ1=DIR("?",1) (opt) Addtional help
  1.  ;
  1.  ;---> Example: D DIR^BIFMAN("SAM",.Y,.BIPOP,"   Select FORMAT: ")
  1.  ;
  1.  I $G(DIR0)']"" S BIPOP=1 Q
  1.  N DIR,X S BIPOP=0,DIR(0)=DIR0
  1.  S:$G(DIRA)]"" DIR("A")=DIRA
  1.  S:$G(DIRB)]"" DIR("B")=DIRB
  1.  S:$G(DIRQ)]"" DIR("?")=DIRQ
  1.  S:$G(DIRQ1)]"" DIR("?",1)=DIRQ1
  1.  D ^DIR
  1.  S:$D(DIRUT) BIPOP=1
  1.  D DKILLS
  1.  Q
  1.  ;
  1.  ;
  1. YESNO ; EP
  1.  ;---> * NOT USED! *
  1.  ;---> Sample Code for Yes/No question.
  1.  W !!?3,"Should this patient's Status be Yes or No?",!
  1.  N DIR
  1.  S DIR(0)="YA"  ; Add "O" (YAO) to make answer optional.
  1.  ;              ; "A" means Append nothing to the DIR("A") prompt.
  1.  S DIR("A")="   Enter Yes or No: "  ; Prompt.
  1.  S DIR("B")="NO"  ; Default.
  1.  S DIR("?",1)="     Enter YES to say Yes."  ; First line of "?" help.
  1.  S DIR("?")="     Enter No to say No."  ; Last line of "?" help.
  1.  D ^DIR W !
  1.  ;---> If answer is YES, Y=1.
  1.  D:Y=1
  1.  .N BIFLD,BIERR S BIFLD(.08)="",BIFLD(.16)=""
  1.  .D FDIE^BIFMAN(9002084,BIDFN,.BIFLD,.BIERR,1)
  1.  .I $G(BIERR)]"" W !!?3,BIERR D DIRZ^BIUTL3() S BIPOP=1
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. FILE(DIC,X,DIC0,DICDR,DINUM,Y,BIPOP) ; EP - Call FILE^DICN
  1.  ;---> Add a new entry to a file.
  1.  ;---> Parameters:
  1.  ;     1 - DIC    (req) DIC, numeric or global ref
  1.  ;     2 - X      (req) .01 value to be added
  1.  ;     3 - DIC0   (req) DIC(0), input parameter string
  1.  ;     4 - DICDR  (opt) DIC("DR")
  1.  ;     5 - DINUM  (opt) IEN of entry to be added
  1.  ;     6 - Y      (ret) Value of Y returned by ^DICN
  1.  ;     7 - BIPOP  (ret) BIPOP=1 if DTOUT OR DUOUT
  1.  ;
  1.  ;---> Example: D FILE^BIFMAN(9002084.35,N,"ML",".02////3")
  1.  ;
  1.  K DD,DO
  1.  I DIC S DLAYGO=DIC,DIC=^DIC(DIC,0,"GL")
  1.  S:$G(DICDR)]"" DIC("DR")=DICDR S DIC(0)=DIC0
  1.  D FILE^DICN
  1.  S BIPOP=$S(($D(DTOUT)!($D(DUOUT))):1,1:0)
  1.  D DKILLS
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DIK ; EP - CALL ^DIK
  1.  D ^DIK
  1.  D DKILLS
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DIQ ; EP - CALL ^DIQ
  1.  D EN^DIQ
  1.  D DKILLS
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DIQ1 ; EP - CALL ^DIQ1
  1.  D EN^DIQ1
  1.  D DKILLS
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DKILLS ;EP
  1.  K D,D0,D1,DA,DD,DDH,DI,DIADD,DIC,DIC1,DICR,DIE,DIG,DIH,DIK,DILC
  1.  K DINUM,DIRUT,DIQ,DIQ2,DIR,DIU,DIW,DIWF,DIWL,DIWR,DIWT,DK,DL
  1.  K DLAYGO,DN,DQ,DR,DTOUT,DUOUT,DX
  1.  D CLEAN^DILF
  1.  Q