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

IBTRHLO2.m

Go to the documentation of this file. 
  1. IBTRHLO2 ;ALB/YMG - Create and send 278 inquiry cont. ;02-JUN-2014
  1.  ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. HLSC(IEN,TSTAMP,HLRESLT) ; update entry in 356.22 on successful creation of HL7 message
  1.  ; called from EN^IBTRHLO
  1.  ; IEN - file 356.22 ien
  1.  ; TSTAMP - timestamp of message creation
  1.  ; HLRESLT - return value of GENERATE^HLMA() API call
  1.  ;
  1.  N IBTRFDA,IENS,MSGID
  1.  S MSGID=$P(HLRESLT,U)
  1.  S IENS=IEN_","
  1.  S IBTRFDA(356.22,IENS,.08)="02"
  1.  S IBTRFDA(356.22,IENS,.12)=MSGID
  1.  S IBTRFDA(356.22,IENS,.15)=TSTAMP
  1.  D FILE^DIE(,"IBTRFDA")
  1.  D CLEAN^DILF
  1.  Q
  1.  ;
  1. HLER(IEN,ERRMSG) ; process error on failure to create HL7 message
  1.  ; called from EN^IBTRHLO
  1.  ; IEN - file 356.22 ien
  1.  ; ERRMSG - error message string
  1.  ;
  1.  N IBTRFDA,IENS
  1.  S IENS=IEN_","
  1.  S IBTRFDA(356.22,IENS,.08)="03"
  1.  D FILE^DIE(,"IBTRFDA")
  1.  K IBTRFDA
  1.  S IENS="?+1,"_IEN_","
  1.  S IBTRFDA(356.22101,IENS,.01)=1
  1.  S IBTRFDA(356.22101,IENS,1)=$E(ERRMSG,1,250)
  1.  D UPDATE^DIE(,"IBTRFDA")
  1.  D CLEAN^DILF
  1.  Q
  1.  ;
  1. WP2STR(FILE,FIELD,IENS,LEN) ; convert word-processing field into a single string
  1.  ; FILE - file #
  1.  ; FIELD - WP field #
  1.  ; IENS - ien string of entry to process, including trailing comma
  1.  ; LEN - maximum length of the output string (if not specified - unlimited length)
  1.  ;
  1.  ; returns string containing data from specified WP field
  1.  ;
  1.  N DATA,STOPFLG,STR,STRLEN,Z
  1.  S STR="",LEN=+$G(LEN),STOPFLG=0
  1.  I $G(FILE),$G(FIELD),$G(IENS) D
  1.  .S Z=$$GET1^DIQ(FILE,IENS,FIELD,,"DATA")
  1.  .S Z="" F  S Z=$O(DATA(Z)) Q:Z=""!STOPFLG  D
  1.  ..S:STR'="" STR=STR_" "
  1.  ..S STRLEN=$L(STR)+$L(DATA(Z)) I LEN,STRLEN>LEN S STOPFLG=1
  1.  ..S STR=STR_$S('LEN:DATA(Z),STRLEN'>LEN:DATA(Z),1:$E(DATA(Z),1,LEN-$L(STR)))
  1.  ..Q
  1.  .Q
  1.  Q STR
  1.  ;
  1. PRVDATA(IEN,FILE) ; get provider data
  1.  ; IEN - ien for the entry
  1.  ; FILE - file number IEN is for
  1.  ;
  1.  ; returns the following string:
  1.  ;  name ^ address line 1 ^ address line 2 ^ city ^ state (file 5 ien) ^ zip ^ NPI
  1.  ;
  1.  N DATA,IENS,NPI,RES,Z
  1.  S RES=""
  1.  I $G(IEN),$G(FILE) D
  1.  .S IENS=IEN_","
  1.  .I FILE=4 D  ; pointer to file 4
  1.  ..D GETS^DIQ(FILE,IENS,".01;4.01:4.05;100","IE","DATA")
  1.  ..S NPI=$P($$NPI^XUSNPI("Organization_ID",IEN),U) S:NPI<1 NPI=""
  1.  ..S RES=$G(DATA(FILE,IENS,100,"E")) I RES="" S RES=$G(DATA(FILE,IENS,.01,"E"))
  1.  ..S RES=RES_U_$G(DATA(FILE,IENS,4.01,"E"))_U_$G(DATA(FILE,IENS,4.02,"E"))_U_$G(DATA(FILE,IENS,4.03,"E"))
  1.  ..S RES=RES_U_$G(DATA(FILE,IENS,4.04,"I"))_U_$G(DATA(FILE,IENS,4.05,"E"))_U_NPI
  1.  ..Q
  1.  .I FILE=200 D  ; pointer to file 200
  1.  ..D GETS^DIQ(FILE,IENS,".01;.111:.116","IE","DATA")
  1.  ..S NPI=$P($$NPI^XUSNPI("Individual_ID",IEN),U) S:NPI<1 NPI=""
  1.  ..S RES=$G(DATA(FILE,IENS,.01,"E"))_U_$G(DATA(FILE,IENS,.111,"E"))
  1.  ..S Z=$G(DATA(FILE,IENS,.113,"E")) ; addr. line 3
  1.  ..S RES=RES_U_$G(DATA(FILE,IENS,.112,"E"))_$S(Z'="":" "_Z,1:"")_U_$G(DATA(FILE,IENS,.114,"E"))
  1.  ..S RES=RES_U_$G(DATA(FILE,IENS,.115,"I"))_U_$TR($G(DATA(FILE,IENS,.116,"E")),"-")_U_NPI
  1.  ..Q
  1.  .I FILE=355.93 D  ; pointer to file 355.93
  1.  ..D GETS^DIQ(FILE,IENS,".01;.05:.08;.1","IE","DATA")
  1.  ..S NPI=$$NPIGET^IBCEP81(IEN)
  1.  ..S RES=$G(DATA(FILE,IENS,.01,"E"))_U_$G(DATA(FILE,IENS,.05,"E"))_U_$G(DATA(FILE,IENS,.1,"E"))
  1.  ..S RES=RES_U_$G(DATA(FILE,IENS,.06,"E"))_U_$G(DATA(FILE,IENS,.07,"I"))_U_$TR($G(DATA(FILE,IENS,.08,"E")),"-")_U_NPI
  1.  ..Q
  1.  .Q
  1.  ; check address integrity, line 1 and city are required
  1.  ; if either is missing, don't return any of the address fields
  1.  I $P(RES,U,2)=""!($P(RES,U,4)="") S $P(RES,U,2,6)="^^^^"
  1.  Q RES
  1.  ;
  1. PCODECNV(CODE) ; provider code conversion between NM1 and PRV X12 segments
  1.  ; CODE - code to convert
  1.  ; returns converted code (NM1 -> PRV), or null if no match found
  1.  N I,NM1STR,PRVSTR,RES
  1.  S NM1STR="71^72^73^AAJ^DD^DK^DN^P3^SJ"
  1.  S PRVSTR="AT^OP^OT^AD^AS^OR^RF^PC^PE"
  1.  S RES=""
  1.  F I=1:1:9 S:$P(NM1STR,U,I)=CODE RES=$P(PRVSTR,U,I) Q:RES'=""
  1.  Q RES
  1.  ;
  1. NTE ; create NTE segment
  1.  N MSG,NTE
  1.  S MSG=$$WP2STR(356.22,12,IBTRIEN_",",264)
  1.  I MSG="" Q
  1.  S NTE="NTE"_HLFS_HLFS_HLFS_$$ENCHL7^IBCNEHLQ(MSG)_HLFS_"MSG 2000E"
  1.  S HCT=HCT+1,^TMP("HLS",$J,HCT)=NTE
  1.  Q
  1.  ;
  1. ZHS ; create ZHS segment
  1.  N QUAL,VALUE,ZHS
  1.  S ZHS="ZHS"_HLFS_"HSD 2000E"  ;ZHS.1 = LOOP ID
  1.  S QUAL=$$GET1^DIQ(365.016,+$P(NODE4,U)_",",.01)
  1.  S VALUE=$P(NODE4,U,2)
  1.  I QUAL'="",VALUE'="" S $P(ZHS,HLFS,3)=QUAL,$P(ZHS,HLFS,4)=VALUE  ;ZHS.2=4.01, ZHS.3=4.02 
  1.  S QUAL=$P(NODE4,U,3)
  1.  S VALUE=$P(NODE4,U,4)
  1.  I QUAL'="",VALUE'="" S $P(ZHS,HLFS,5)=QUAL  ;ZHS.4=4.03
  1.  I VALUE'="" S $P(ZHS,HLFS,6)=VALUE  ;ZHS.5=4.04
  1.  S QUAL=$$GET1^DIQ(365.015,+$P(NODE4,U,5)_",",.01)
  1.  S VALUE=$P(NODE4,U,6)
  1.  I QUAL'="",VALUE'="" S $P(ZHS,HLFS,7)=QUAL,$P(ZHS,HLFS,8)=VALUE ;ZHS.6=4.05, ZHS.7=4.06
  1.  S $P(ZHS,HLFS,9)=$$GET1^DIQ(365.025,+$P(NODE4,U,7)_",",.01) ;ZHS.8=4.07
  1.  S $P(ZHS,HLFS,10)=$$GET1^DIQ(356.007,+$P(NODE4,U,8)_",",.01) ;ZHS.9=4.08
  1.  I $TR($P(ZHS,HLFS,3,99),HLFS)="" Q
  1.  S HCT=HCT+1,^TMP("HLS",$J,HCT)=ZHS
  1.  Q