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

BLRRLEDI.m

Go to the documentation of this file. 
  1. BLRRLEDI ;cmi/flag/maw - BLR REFERENCE LAB LEDI UTILITIES ; 02-Nov-2015 13:43 ; MAW
  1.  ;;5.2;IHS LABORATORY;**1027,1031,1033,1034,1035,1037**;NOV 01, 1997;Build 4
  1.  ;
  1.  ;
  1. ORD(OR,PAT) ;-- lets create the order stub here
  1.  I $O(^BLRRLO("B",OR,0)) Q $O(^BLRRLO("B",OR,0))
  1.  N FDA,FIENS,FERR
  1.  S FIENS=""
  1.  S FDA(9009026.3,"+1,",.01)=OR
  1.  S FDA(9009026.3,"+1,",.04)=PAT
  1.  D UPDATE^DIE("","FDA","FIENS","FERR(1)")
  1.  I $D(FERR(1)) W !,"Error adding order number "_OR_" to Reference Lab Order file" Q ""
  1.  Q $G(FIENS(1))
  1.  ;
  1. ACC(AC,OR,PAT,CDT) ;-- add the accession number to the order
  1.  N FI,FIENS,FDA,FERR,ORI
  1.  I '$G(CDT) S CDT=DT
  1.  S FI=$O(^BLRRLO("B",OR,0))
  1.  I '$G(FI) S FI=$$ORD(OR,PAT)
  1.  I '$G(FI) Q ""
  1.  I $P($G(^BLRRLO(FI,0)),U,4)'=PAT Q ""
  1.  S FIENS=FI_","
  1.  S FDA(9009026.33,"?+2,"_FIENS,.01)=AC
  1.  D UPDATE^DIE("","FDA","FIENS","FERR(1)")
  1.  I $D(FERR(1)) W !,"Error adding accession number "_AC_" to Order "_OR_" in the Reference Lab Order file" Q ""
  1.  Q $G(FI)
  1.  ;
  1. DX(OR) ;-- lets add/edit diagnosis here
  1.  ;need to modify this here to look and see if there are diagnosis already here and if so bring them up to modify 
  1.  N ORI
  1.  K BLRDFLG
  1.  S ORI=$O(^BLRRLO("B",OR,0))
  1.  I $O(^BLRRLO(ORI,1,"B",0)) D
  1.  . S BLRDXS=1
  1.  . S BLRDFLG=$$DXV(ORI)
  1.  I $G(BLRDFLG)]"",$G(BLRDFLG)="D" D DELDX,DX(OR)
  1.  I $G(BLRDFLG)]"",$G(BLRDFLG)'="A" Q
  1.  S DA(1)=ORI
  1.  S DIC(0)="AELMQZ"
  1.  S DIC("A")="Enter ICD Diagnosis code for billing: "
  1.  S DIC="^BLRRLO("_ORI_",1,"
  1.  S DIC("DR")="1////"_$G(BLRTS)
  1.  D ^DIC
  1.  Q:Y<0
  1.  S BLRDXS=1
  1.  D DX(OR)  ;allow adding until they ^ out
  1.  Q
  1.  ;
  1. DXV(RI) ;-- display the diagnosis and ask if they want to delete or add
  1.  N RDA,RCNT,RDATA,RDX
  1.  S RCNT=0
  1.  K BLRRLDAT
  1.  W !,"There are existing Diagnosis attached to this order",!
  1.  S RDA=0 F  S RDA=$O(^BLRRLO(ORI,1,RDA)) Q:'RDA  D
  1.  . S RCNT=RCNT+1
  1.  . S RDATA=$G(^BLRRLO(ORI,1,RDA,0))
  1.  . S BLRRLDAT(RCNT)=RDA
  1.  . ;remove comments below for proposed change 1034
  1.  . I $D(^ICDS(0)) S RDX=$$ICDDX^ICDEX($P(RDATA,U),DT)
  1.  . I '$D(^ICDS(0)) S RDX=$$ICDDX^ICDCODE($P(RDATA,U),DT)
  1.  . ;W !,RCNT_") Dx: "_$$GET1^DIQ(80,$P(RDATA,U),.01),?15,"Test: "_$$GET1^DIQ(60,$P(RDATA,U,2),.01)
  1.  . W !,RCNT_") Dx: "_$P(RDX,U,2),?15,"Text: "_$P(RDX,U,4)
  1.  K DIR
  1.  S DIR(0)="S^A:Add a New DX;D:Delete an Existing DX;U:Use existing DX",DIR("A")="Select an Option"
  1.  S DIR("B")="U"
  1.  D ^DIR
  1.  Q:$D(DIRUT) 0
  1.  Q Y
  1.  ;
  1. DELDX ;-- delete an existing dx in the file
  1.  N DXD,DAT
  1.  K DIR
  1.  S DIR(0)="N^1:"_$O(BLRRLDAT(""),-1),DIR("A")="Delete which DX"
  1.  D ^DIR
  1.  Q:$D(DIRUT)
  1.  S DAT=+Y
  1.  S DA=+$G(BLRRLDAT(DAT))
  1.  S DIK="^BLRRLO("_ORI_",1,"
  1.  S DA(1)=ORI
  1.  D ^DIK
  1.  Q
  1.  ;
  1. CLIENT(OR,AC) ;client account number
  1.  I +$G(BLRAGUI) Q $$CLIENTG(OR,AC)
  1.  N BLRCLCNT
  1.  S BLRCLCNT=$$CLCNT(DUZ(2))
  1.  I $G(BLRCLCNT)=1 D
  1.  . S BLRRL("CLIENT")=$O(^BLRSITE($S($G(BLRALTDZ):BLRALTDZ,1:DUZ(2)),"RLCA","B",""))
  1.  . I $G(BLRRL("CLIENT"))="" S BLRRL("CLIENT")=$P($G(^BLRRL(BLRRL("RL"),0)),U,13)
  1.  I $G(BLRCLCNT)>1 D
  1.  . W !,"Please select the appropriate account number for this accession"
  1.  . N BLRRLD
  1.  . S BLRRLD=0 F  S BLRRLD=$O(BLRCLA(BLRRLD)) Q:'BLRRLD  D
  1.  .. W !,BLRRLD_") "_$G(BLRCLA(BLRRLD))
  1.  . K DIR
  1.  . S DIR(0)="N^1:"_$G(BLRCLCNT),DIR("A")="Which account number for this accession "
  1.  . D ^DIR
  1.  . Q:$D(DIRUT)
  1.  . S BLRRL("CLIENT")=$G(BLRCLA(+Y))
  1.  . S BLRRLCLT=BLRRL("CLIENT")
  1.  I $G(BLRRL("CLIENT"))="" D CLIENT(OR,AC)
  1.  S BLRRLCLA=1
  1.  N FDA,FIENS,FERR,FI
  1.  S FI=$O(^BLRRLO("B",OR,0))
  1.  S FIENS=FI_","
  1.  S FDA(9009026.3,FIENS,.03)=$G(BLRRL("CLIENT"))
  1.  D FILE^DIE("K","FDA","FERR(1)")
  1.  I $D(FERR(1)) W !,"Error adding client account number "_$G(BLRRL("CLIENT"))_" to Order "_OR_" in the Reference Lab Order file" Q ""
  1.  Q $G(FI)
  1.  ;
  1. CLIENTG(OR,AC) ;store client account number (GUI)
  1.  N BLRCLCNT
  1.  S BLRCLCNT=$$CLCNT(DUZ(2))
  1.  S BLRRL("CLIENT")=BLRRLCLA
  1.  S BLRRLCLT=BLRRL("CLIENT")
  1.  S BLRRLCLA=1
  1.  N FDA,FIENS,FERR,FI
  1.  S FI=$O(^BLRRLO("B",OR,0))
  1.  Q:$P($G(^BLRRLO(FI,0)),U,3)]""
  1.  S FIENS=FI_","
  1.  S FDA(9009026.3,FIENS,.03)=$G(BLRRL("CLIENT"))
  1.  D FILE^DIE("K","FDA","FERR(1)")
  1.  ;I $D(FERR(1)) W !,"Error adding client account number "_$G(BLRRL("CLIENT"))_" to Order "_OR_" in the Reference Lab Order file" Q ""
  1.  Q $G(FI)
  1.  ;
  1. CLCNT(DZ2) ;-- get the number of client account numbers to see if we need to prompt
  1.  N BLRRLDA,BLRCLC
  1.  S BLRCLC=0
  1.  S BLRRLDA=0 F  S BLRRLDA=$O(^BLRSITE($S($G(BLRALTDZ):BLRALTDZ,1:DZ2),"RLCA","B",BLRRLDA)) Q:BLRRLDA=""  D
  1.  . S BLRCLC=BLRCLC+1
  1.  . S BLRCLA(BLRCLC)=BLRRLDA
  1.  Q +$G(BLRCLC)
  1.  ;
  1. BTP(OR,BT) ;-- file the bill type
  1.  N FI,FIENS,FDA,FERR
  1.  S FI=$O(^BLRRLO("B",OR,0))
  1.  S FIENS=FI_","
  1.  I $G(BT)="" S BT="C"
  1.  S FDA(9009026.3,FIENS,.05)=BT
  1.  D FILE^DIE("K","FDA","FERR(1)")
  1.  I $D(FERR(1)) W !,"Error adding bill type "_BT_" to Order "_OR_" in the Reference Lab Order file" Q ""
  1.  Q $G(FI)
  1.  ;
  1. BILL(BTP,OR,AC,CDT) ;-- this is where we ask billing type
  1.  I $G(BLRGUI) D  Q
  1.  .; I $G(BLRRL("BILL TYPE"))="" I "CTP"[$G(BLRBT) S BLRRL("BILL TYPE")=BLRBT,BLRINS=1 S BT=$$BTP(OR,BTP) Q
  1.  .I $G(BLRRL("BILL TYPE"))="" I $L($G(BLRBT)),"CTP"[$G(BLRBT) S BLRRL("BILL TYPE")=BLRBT,BLRINS=1 S BT=$$BTP(OR,BTP) Q    ; IHS/MSC/MKK - LR*5.2*1034
  1.  .I $G(BLRRL("BILL TYPE"))="" S BLRRL("BILL TYPE")=$P($G(^BLRSITE($S($G(BLRALTDZ):BLRALTDZ,1:DUZ(2)),"RL")),U,15)
  1.  .S:$G(BLRRL("BILL TYPE"))'="" BLRINS=1
  1.  Q:$G(BLRGUI)
  1.  N BT,ORI
  1.  I '$G(CDT) S CDT=$P($G(^BLRRLO($O(^BLRRLO("B",OR,0)),0)),U,6)
  1.  I '$G(CDT) S CDT=DT
  1.  I BTP'="T" D  Q
  1.  . S BT=$$BTP(OR,BTP)
  1.  K DIR,DIRUT,DTOUT,DUOUT   ; Clear DIR array and special FileMan variables - IHS/MSC/MKK - LR*5.2*1034
  1.  S DIR(0)="S^C:Client;T:Third Party;P:Patient"
  1.  S DIR("A")="Which Party is Responsible for Billing: "
  1.  S DIR("B")=$P($G(^BLRSITE($S($G(BLRALTDZ):BLRALTDZ,1:DUZ(2)),"RL")),U,15)
  1.  D ^DIR
  1.  I $D(DIRUT) K Y  S Y="C",Y(0)="Client"     ; If user exits or Times Out, reset Y variable - IHS/MSC/MKK - LR*5.2*1034
  1.  S BLRRL("BILL TYPE")=Y(0)
  1.  S BT=$$BTP(OR,$G(Y))
  1.  ;I $D(DIRUT) S BLRRL("BILL TYPE")="Client"      ; Comment out line - IHS/MSC/MKK LR*5.2*1034
  1.  K DIR
  1.  I $E(BLRRL("BILL TYPE"),1,1)="T" D
  1.  . S ORI=$O(^BLRRLO("B",OR,0))
  1.  . I $O(^BLRRLO(ORI,1,"B",0)) S BLRDXS=1
  1.  . D INS(OR,AC,DFN,CDT,0)
  1.  I $E(BLRRL("BILL TYPE"),1,1)="T",'$G(BLRDXS) W !,"You must select an ICD Diagnosis if Bill Type is Third Party" D DX(OR)
  1.  I $E(BLRRL("BILL TYPE"),1,1)="T",'$G(BLRINSS) W !,"You must select an Insurer if Bill Type is Third Party" D BILL(BTP,OR,AC)
  1.  S BLRINS=1
  1.  Q
  1.  ;
  1. INS(OR,AC,PAT,CD,ED) ;-- lets get a list of selectable insurances for the patient and if set for auto select pick the first one in sequence
  1.  ;we must also setup the BLRRL insurance array and diagnosis array for GIS
  1.  N INSS,BT,BDA,BDAC,BLRRLDA,BLRNUM
  1.  K AGINS,AGINSNN,AGINSN  ;ihs/cmi/maw 07/24/2013 patch 1033
  1.  S BDAC=0
  1.  S DFN=PAT
  1.  D ^AGINS
  1.  I '$D(AGINS(1)),$E($G(BLRRL("BILL TYPE")),1,1)="T" D  Q
  1.  . W !,"Patient has No Insurance on file, changing Bill Type to Client"
  1.  . S BT=$$BTP(OR,"C")
  1.  I $P($G(^BLRSITE($S($G(BLRALTDZ):BLRALTDZ,1:DUZ(2)),"RL")),U,21) D  Q  ;get flag for insurance
  1.  . W !,"Now applying Sequenced Insurer to Accession"
  1.  . I '$G(CD) S CD=DT
  1.  . D SEQINS(.AGINS,PAT,CD)
  1.  . I '$D(BLRSEQ(1)) D  Q
  1.  .. W !,"Patient Insurance has not been Sequenced, changing Bill Type to Client"
  1.  .. S BT=$$BTP(OR,"C")
  1.  . S BDA=0 F  S BDA=$O(BLRSEQ(BDA)) Q:'BDA!(BDAC>3)  D
  1.  .. S BDAC=BDAC+1
  1.  .. S INSS=$TR($G(BLRSEQ(BDA)),"^","~")  ;have to switch to ~ for filing
  1.  .. D UPINS(OR,AC,PAT,INSS)
  1.  S BLRRLDA=0 F  S BLRRLDA=$O(AGINS(BLRRLDA)) Q:'BLRRLDA  D
  1.  . S BLRNUM=BLRRLDA
  1.  . W !,BLRRLDA_")"_$P(AGINS(BLRRLDA),U)_$S($P(AGINS(BLRRLDA),U,4)]"":"("_$E($P(AGINS(BLRRLDA),U,4),1,2)_")",1:"")
  1.  . W ?30,"Policy #: "_$P(AGINS(BLRRLDA),U,9)
  1.  . W ?50,"Elg/Exp Date: "_$S($P(AGINS(BLRRLDA),U,5)>0:$$FMTE^XLFDT($P(AGINS(BLRRLDA),U,5)),1:"")_"/"_$S($P(AGINS(BLRRLDA),U,6)>0:$$FMTE^XLFDT($P(AGINS(BLRRLDA),U,6)),1:"")
  1.  K DIR,DIRUT,DTOUT,DUOUT
  1.  S DIR(0)="N"_$S(ED:"O",1:"")_"^1:"_+$G(BLRNUM),DIR("A")="Select the insurer for this accession: "
  1.  D ^DIR
  1.  Q:$D(DIRUT)
  1.  Q:Y<0
  1.  S BLRINS=+Y
  1.  S INSS=$TR($G(AGINS(BLRINS)),"^","~")  ;have to switch to ~ for filing
  1.  D UPINS(OR,AC,PAT,INSS)
  1.  Q
  1.  ;
  1. UPINS(O,A,P,S) ;-- update the entry in the BLR REFERENCE LAB ORDER/ACCESSION file
  1.  N FI,FDA,FIENS,FERR
  1.  S FI=$O(^BLRRLO("B",O,0))
  1.  I '$G(FI) S FI=$O(^BLRRLO("ACC",A,0))
  1.  S FIENS=FI_","
  1.  S FDA(9009026.32,"+2,"_FIENS,.01)=S
  1.  D UPDATE^DIE("","FDA","FIENS","FERR(1)")
  1.  I $D(FERR(1)) W !,"Error adding insurance to Order "_OR_" in the Reference Lab Order file"
  1.  S BLRINSS=1
  1.  Q
  1.  ;
  1. SEQINS(BINS,PT,RLCDT) ;-- lets go through sequencing insurers
  1.  Q:'$O(BINS(""))
  1.  K BLRSEQ  ;ihs/cmi/maw 10/07/2013 patch 1033
  1.  N BDA
  1.  S BDA=0 F  S BDA=$O(BINS(BDA)) Q:'BDA  D
  1.  . N BINI,SEQ,POLI
  1.  . S BINI=$P(BINS(BDA),U,2)
  1.  . S POLI=$P(BINS(BDA),U,9)
  1.  . S SEQ=$$FNDSEQ(BINI,PT,POLI,RLCDT)
  1.  . Q:'SEQ
  1.  . S BLRSEQ(SEQ)=$G(BINS(BDA))
  1.  Q
  1.  ;
  1. FNDSEQ(BN,PTI,POL,CDT) ;-- find the category prioritization
  1.  N SQDA,EFF,SQPRI
  1.  S EFF=$O(^AUPNICP("EFF",PTI,"M",""),-1)
  1.  I '$G(EFF) Q ""
  1.  S SQDA=0 F  S SQDA=$O(^AUPNICP("EFF",PTI,"M",EFF,SQDA)) Q:'SQDA!($G(SQPRI))  D
  1.  . N SQDATA,SQPAT,SQPOL,SQINS
  1.  . S SQDATA=$G(^AUPNICP(SQDA,0))
  1.  . S SQPAT=$P(SQDATA,U,2)
  1.  . S SQINS=$P(SQDATA,U,3)
  1.  . S SQPOL=$P(SQDATA,U,10)
  1.  . Q:SQPAT'=PTI
  1.  . Q:SQINS'=BN
  1.  . Q:SQPOL'=POL
  1.  . S SQPRI=$P(SQDATA,U,5)
  1.  Q $G(SQPRI)
  1.  ;
  1. EORD ;-- Edit the Order
  1.  K DIC,DIE
  1.  N DATA,ORD,ACC,PAT,CDT
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Edit insurance/billing information for which order number: "
  1.  S DIC="^BLRRLO("
  1.  D ^DIC
  1.  Q:Y<0
  1.  S DIE=DIC
  1.  S DA=+Y
  1.  S DR=".03;.05;1"
  1.  D ^DIE
  1.  S DATA=$G(^BLRRLO(DA,0))
  1.  S ORD=$P(DATA,U)
  1.  S ACC=$P(DATA,U,2)
  1.  S PAT=$P(DATA,U,4)
  1.  S CDT=$P(DATA,U,6)
  1.  D COINS(DA)
  1.  D INS(ORD,ACC,PAT,CDT,1)
  1.  D EORD
  1.  Q
  1.  ;
  1. COINS(IN) ;-- clean out insurances before reselecting
  1.  N BDA
  1.  S DIK="^BLRRLO("_IN_",2,"
  1.  S DA(1)=IN
  1.  S BDA=0 F  S BDA=$O(^BLRRLO(IN,2,BDA)) Q:'BDA  D
  1.  . S DA=BDA
  1.  . D ^DIK
  1.  Q
  1.  ;