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

IBCIUT6.m

Go to the documentation of this file. 
  1. IBCIUT6 ;DSI/ESG - MAILMAN UTILITIES ;22-JUN-2001
  1.  ;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. CAT(IBIFN,IBCIFRM,IBCITO,IBCIGRP,GRPONLY) ; MailMan message sending
  1.  ; This procedure is called when the user is assigning a bill to
  1.  ; another user.
  1.  ;
  1.  ; Input variables
  1.  ;   IBIFN    -  IEN of claim
  1.  ;   IBCIFRM  -  DUZ of person assigning the claim
  1.  ;   IBCITO   -  DUZ of person being assigned the claim
  1.  ;   IBCIGRP  -  IEN of the Mail Group to receive this msg
  1.  ;               (optional - default is "")
  1.  ;   GRPONLY  -  1/0 flag indicating if the Mail Group is the only
  1.  ;               entity to receive the mail message.
  1.  ;               (optional - default is 0)
  1.  ;
  1.  NEW ERRDATA,ERRLVL,IBCIASI,IBCIASN,IBCIBII,IBCIBIL,IBCIBIR,IBCICAR
  1.  NEW IBCICLNO,IBCICLNP,IBCICNM,IBCICOD,IBCIDAT,IBCIDOB,IBCIDPT,IBCIEVEN
  1.  NEW IBCIEVV,IBCIFRM1,IBCIINS,IBCINAM,IBCIPAD,IBCIPRV,IBCIPTI,IBCISER
  1.  NEW IBCISEX,IBCISRR,IBCISSN,IBCITO1,L1,L2,L3,LINENO,MNEMONIC,PREVLINE
  1.  NEW SEP,TEXT,VALMHDR,XMDUN,XMDUZ,XMZ,XMMG,XMSUB,XMTEXT,XMY
  1.  ;
  1.  S IBCIGRP=$G(IBCIGRP,"")
  1.  S GRPONLY=$G(GRPONLY,0)
  1.  I IBCIGRP S IBCIGRP=$P($G(^XMB(3.8,IBCIGRP,0)),U,1)   ; Mail Group name
  1.  S IBCICLNP=$P(^DGCR(399,IBIFN,0),U,1)
  1.  S IBCIFRM1=$P(^VA(200,IBCIFRM,0),U,1)
  1.  S IBCITO1=$P(^VA(200,IBCITO,0),U,1)
  1.  S XMDUZ=IBCIFRM
  1.  S XMSUB="ClaimsManager Claim "_IBCICLNP_" Assigned to "_IBCITO1
  1.  ;
  1.  S L1=1
  1.  S TEXT(L1)=$J(IBCICLNP_" has been assigned to: ",32)_IBCITO1,L1=L1+1
  1.  S TEXT(L1)=$J("by: ",32)_IBCIFRM1,L1=L1+1
  1.  S TEXT(L1)=" ",L1=L1+1
  1.  ;
  1.  ; If comments exist, then display them here
  1.  ;
  1.  I $P($G(^IBA(351.9,IBIFN,2,0)),U,4) D
  1.  . S TEXT(L1)=$$CMTINFO^IBCIUT5(IBIFN),L1=L1+1
  1.  . S TEXT(L1)=" ",L1=L1+1
  1.  . S L2=0
  1.  . F  S L2=$O(^IBA(351.9,IBIFN,2,L2)) Q:'L2  D
  1.  .. S TEXT(L1)=^IBA(351.9,IBIFN,2,L2,0),L1=L1+1
  1.  .. Q
  1.  . S TEXT(L1)=" ",L1=L1+1
  1.  . S TEXT(L1)=" ",L1=L1+1
  1.  . Q
  1.  ;
  1.  ; Now get and display the patient and claim data
  1.  ;
  1.  D GDATA^IBCIWK,HDR^IBCIMG
  1.  S $P(SEP,"-",80)=""       ; 79 dashes
  1.  S TEXT(L1)=$E(SEP,1,24)_" Patient and Claim Information "
  1.  S TEXT(L1)=TEXT(L1)_$E(SEP,1,24),L1=L1+1
  1.  S TEXT(L1)=VALMHDR(1),L1=L1+1
  1.  S TEXT(L1)=VALMHDR(2),L1=L1+1
  1.  S TEXT(L1)=VALMHDR(3),L1=L1+1
  1.  S TEXT(L1)=SEP,L1=L1+1
  1.  S TEXT(L1)=" ",L1=L1+1
  1.  S TEXT(L1)=$J("ClaimsManager Errors and Line Item Data",59),L1=L1+1
  1.  S TEXT(L1)=" ",L1=L1+1
  1.  ;
  1.  ; Display a message if there are no errors in the file
  1.  I '$P($G(^IBA(351.9,IBIFN,1,0)),U,4) D
  1.  . S TEXT(L1)=$J("*** No ClaimsManager Errors to Report ***",60),L1=L1+1
  1.  . S TEXT(L1)=" ",L1=L1+1
  1.  . Q
  1.  ;
  1.  ; Loop through the CM errors and get and display the data
  1.  S L2=0
  1.  S PREVLINE=-9999999
  1.  F  S L2=$O(^IBA(351.9,IBIFN,1,L2)) Q:'L2  D
  1.  . S ERRDATA=$G(^IBA(351.9,IBIFN,1,L2,0))
  1.  . S LINENO=+$P(ERRDATA,U,2)
  1.  . I LINENO'=PREVLINE D LINEDATA(IBIFN,LINENO) S PREVLINE=LINENO
  1.  . S MNEMONIC=$P(ERRDATA,U,1)
  1.  . S ERRLVL="Error Level: "_$P(ERRDATA,"~",2)
  1.  . S TEXT(L1)="("_L2_") ClaimsManager Error: "_MNEMONIC
  1.  . S TEXT(L1)=(TEXT(L1)_$J(ERRLVL,78-$L(TEXT(L1)))),L1=L1+1
  1.  . S L3=0
  1.  . F  S L3=$O(^IBA(351.9,IBIFN,1,L2,1,L3)) Q:'L3  D
  1.  .. S TEXT(L1)="     "_$G(^IBA(351.9,IBIFN,1,L2,1,L3,0)),L1=L1+1
  1.  .. Q
  1.  . S TEXT(L1)=" ",L1=L1+1
  1.  . Q
  1.  ;
  1.  ; Now time to do the MailMan stuff
  1.  S XMTEXT="TEXT("                           ; msg text
  1.  I 'GRPONLY S XMY("I:"_IBCITO)=""           ; info only msg to recipient
  1.  I 'GRPONLY S XMY("I:"_IBCIFRM)=""          ; info only msg to sender
  1.  I IBCIGRP'="" S XMY("I:G."_IBCIGRP)=""     ; info only msg to group
  1.  D ^XMD
  1.  ;
  1.  ; look at the IB site parameter file to see if we should send
  1.  ; priority or normal MailMan messages
  1.  I '$G(XMZ) G CATX                            ; no msg created
  1.  I $P($G(^IBE(350.9,1,50)),U,7)="N" G CATX    ; normal messages
  1.  S $P(^XMB(3.9,XMZ,0),U,7)="P"                ; priority messages
  1. CATX ;
  1.  Q
  1.  ;
  1.  ;
  1. LINEDATA(IBIFN,LINE) ; Get and display the line item info
  1.  NEW BEGDATE,CHRG,COLHDR,CPT,DXCODE,DXSTRING,ENDDATE,KILLTMP
  1.  NEW LNA,LNB,MOD,MODS,MOD2,POS,SEQ,TOS,UNIT,X,X1,X2,X3,X4,Y
  1.  ;
  1.  ; Conditionally build the 3,4,5 nodes.  Use this flag to indicate
  1.  ; whether or not to kill these nodes when we're done.
  1.  S KILLTMP=0
  1.  I '$P($G(^IBA(351.9,IBIFN,3)),U,1) S KILLTMP=1 D UPDT^IBCIADD1
  1.  S COLHDR="----------BEG DATE----END DATE----POS---TOS--CPT------"
  1.  S COLHDR=COLHDR_"MOD-------CHARGE-----UNIT"
  1.  S LNA=$G(^IBA(351.9,IBIFN,5,LINE,0))
  1.  S LNB=$G(^IBA(351.9,IBIFN,5,LINE,2))
  1.  S BEGDATE=$P(LNA,U,6)
  1.  S BEGDATE=$E(BEGDATE,5,6)_"/"_$E(BEGDATE,7,8)_"/"_$E(BEGDATE,1,4)
  1.  S ENDDATE=$P(LNA,U,7)
  1.  S ENDDATE=$E(ENDDATE,5,6)_"/"_$E(ENDDATE,7,8)_"/"_$E(ENDDATE,1,4)
  1.  S POS=$P(LNA,U,8)
  1.  S TOS=$P(LNB,U,11)
  1.  S CPT=$P(LNA,U,9)
  1.  S MODS=$TR($P($G(^IBA(351.9,IBIFN,5,LINE,3)),U,1),",")
  1.  S MOD=$E(MODS,1,6),MOD2=$E(MODS,7,999)
  1.  S CHRG=$FN($P(LNA,U,11),"",2)
  1.  S UNIT=$P(LNB,U,12)
  1.  ;
  1.  ; Get the diagnosis information for this line
  1.  KILL ^TMP("DISPLAY",$J)
  1.  S DXSTRING=""
  1.  D DIAG^IBCIUT1(IBIFN)
  1.  S SEQ=0
  1.  F  S SEQ=$O(^TMP("DISPLAY",$J,IBIFN,"ICD",LINE,SEQ)) Q:'SEQ  D
  1.  . S DXCODE=^TMP("DISPLAY",$J,IBIFN,"ICD",LINE,SEQ)
  1.  . I DXSTRING="" S DXSTRING=DXCODE
  1.  . E  S DXSTRING=DXSTRING_" / "_DXCODE
  1.  . Q
  1.  KILL ^TMP("DISPLAY",$J)
  1.  ;
  1.  ; Now build the text strings for the line item data
  1.  S TEXT(L1)=COLHDR,L1=L1+1
  1.  S TEXT(L1)=" Line: "
  1.  S X=LINE,X1=3,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
  1.  S X=BEGDATE,X1=12,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
  1.  S X=ENDDATE,X1=12,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
  1.  S X=POS,X1=6,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
  1.  S X=TOS,X1=5,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
  1.  S X=CPT,X1=9,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
  1.  S X=MOD,X1=6,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
  1.  S X=CHRG,X1=10,X2="R" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
  1.  S TEXT(L1)=TEXT(L1)_"      "
  1.  S X=UNIT,X1=3,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
  1.  S L1=L1+1
  1.  S TEXT(L1)=" Dx's: "
  1.  I $L(DXSTRING)<46,MOD2'="" D
  1.  . S X=DXSTRING,X1=47,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
  1.  . S X=MOD2,X1=8,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
  1.  . Q
  1.  E  S TEXT(L1)=TEXT(L1)_DXSTRING
  1.  S L1=L1+1
  1.  ;
  1. LINDATX ;
  1.  I KILLTMP D DELTI^IBCIUT4
  1.  Q
  1.  ;
  1. TOP(IBIFN)  ; This utility returns the type of plan for the current payer
  1.  ; sequenced insurance company.  This is currently used for the
  1.  ; ClaimsManager UserDefined field #4.
  1.  ; The data in this field is the actual type of plan defined on VistA.
  1.  N IBCITOP,GRPPLAN,IBCISEQ,INSSEQ,TOPIEN
  1.  S IBCITOP=""
  1.  S IBCISEQ=$$COBN^IBCEF(IBIFN)
  1.  S INSSEQ="I"_IBCISEQ
  1.  S GRPPLAN=$P($G(^DGCR(399,IBIFN,INSSEQ)),U,18)
  1.  I GRPPLAN="" G TOPX
  1.  S TOPIEN=$P($G(^IBA(355.3,GRPPLAN,0)),U,9)
  1.  I TOPIEN="" G TOPX
  1.  S IBCITOP=$P($G(^IBE(355.1,TOPIEN,0)),U,2)
  1. TOPX ;
  1.  Q IBCITOP
  1.  ;
  1. CLRCMQ(MSG) ;
  1.  ; This procedure will try to clear out the CM result queue by opening
  1.  ; and using every available port and just reading in any and all 
  1.  ; data CM is wanting to send.
  1.  ;
  1.  ; Input:  MSG is either 0 or 1 which will determine if status messages
  1.  ;         and/or error messages are displayed on the screen.
  1.  ;         MSG=0 silent mode
  1.  ;         MSG=1 display on screen mode
  1.  ;
  1.  ; Output:  None (either it will work or it won't)
  1.  ;
  1.  NEW IBCIIP,PORTS,IBCISOCK,JTOT,POP,J,TRASH,SET,IBCIMT
  1.  NEW X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  S MSG=$G(MSG,1)
  1.  S IBCIMT=$$ENV^IBCIUT5
  1.  I 'MSG,IBCIMT="T" G CLRX    ; don't allow silent mode from TEST acct
  1.  ;
  1.  ; If a site isn't using the interface, then display message and exit
  1.  I '$$CK0^IBCIUT1(),MSG D  G CLRX
  1.  . U IO(0)
  1.  . W !!!?5,"The ClaimsManager product is not being used."
  1.  . W !!?5,"This option is not available.",!!
  1.  . S DIR(0)="E" D ^DIR K DIR
  1.  . Q
  1.  ;
  1.  I MSG D  I 'Y G CLRX
  1.  . U IO(0)
  1.  . W @IOF
  1.  . W !?20,"Clear ClaimsManager Results Queue",!
  1.  . W !?2,"This option attempts to clear out the ClaimsManager Results Queue so"
  1.  . W !?2,"ClaimsManager can get back in sync with VistA.  If this process doesn't"
  1.  . W !?2,"correct the problems, then Ingenix should be called (800-765-6818)."
  1.  . W !
  1.  . I IBCIMT="T" D
  1.  .. W !?2,"Please note that you're doing this from the TEST account.  This may be"
  1.  .. W !?2,"risky if there are Production users using ClaimsManager."
  1.  .. W !
  1.  .. Q
  1.  . S DIR(0)="Y"
  1.  . S DIR("A")="OK to proceed"
  1.  . S DIR("B")="YES"
  1.  . DO ^DIR K DIR
  1.  . Q
  1.  ;
  1.  L +^IBCITCP:15 E  W:MSG !!,"Couldn't Lock all Ports" G CLRX
  1.  S IBCIIP=$P($G(^IBE(350.9,1,50)),U,5)
  1.  I IBCIIP="" W:MSG !!,"No IP address" G CLRX
  1.  M PORTS=^IBE(350.9,1,50.06,"B")
  1.  I '$D(PORTS) W:MSG !!,"No Ports defined" G CLRX
  1.  S SET=0
  1. AGAIN ;
  1.  S SET=SET+1
  1.  W:MSG !!,"Set ",SET
  1.  S IBCISOCK="",JTOT=0
  1.  F  S IBCISOCK=$O(PORTS(IBCISOCK)) Q:IBCISOCK=""  D
  1.  . W:MSG !?1,"Port# ",IBCISOCK
  1.  . D CALL^%ZISTCP(IBCIIP,IBCISOCK,1)
  1.  . I POP W:MSG ?16,"FAILURE:  Couldn't open port!!" Q
  1.  . F J=0:1 R TRASH#1:1 Q:'$T  Q:$A(TRASH)=3  Q:TRASH=""
  1.  . S JTOT=JTOT+J
  1.  . W $C(1,6,3),!
  1.  . D CLOSE^%ZISTCP
  1.  . I 'MSG Q
  1.  . U IO(0)
  1.  . W ?15,$J(J,5)," characters read"
  1.  . W ?40,"ACK sent to CM"
  1.  . W ?58,"Port Closed"
  1.  . Q
  1.  W:MSG !,"Results of Set ",SET,":  "
  1.  I JTOT W:MSG "Data was detected.  Repeating the process." H 1 G AGAIN
  1.  W:MSG "No data found.  Process is complete.",!!
  1. CLRX ;
  1.  L -^IBCITCP
  1.  Q
  1.  ;