IB20P342 ;DALOI/SS - IB ECME EVNT REPORT ;01/03/2006
;;2.0;INTEGRATED BILLING;**342**;21-MAR-94;Build 18
;; Per VHA Directive 10-93-142, this routine should not be modified.
;;
Q
;
;move data from ^XTMP("IBNCPDP-..." to file #366.14
EN ;
N IBDT,IBRECNO,IBDATE,IBIBDTYP,IBRET,IBTYPE,IBDTIEN,IBCALVAL
N IBMSG1,IBMSG2
I +$O(^IBCNR(366.14,0)) D Q
. D ERRMSG("Conversion of IB ECME EVNT REPORT data will not be done in this site")
. D ERRMSG("since data have been already converted in the past.")
. ;send e-mail about post-install completion
. S IBMSG1="The conversion of data from the ^XTMP global array into the IB NCPDP"
. S IBMSG2="EVENT LOG file has been skipped as the data has already been converted."
. D SNDMAIL("IB*2.0*342 installation has been completed",IBMSG1,IBMSG2)
S IBDT="IBNCPDP-"
F S IBDT=$O(^XTMP(IBDT)) Q:IBDT'["IBNCPDP-" D
. S IBRECNO=0
. S IBDATE=+$P(IBDT,"-",2)
. D BMES^XPDUTL("Add date: "_IBDATE)
. S IBDTIEN=$$ADDDATE^IBNCPLOG(IBDATE)
. I +IBDTIEN=0 D ERRMSG("Cannot create a DATE entry for "_IBDATE)
. F S IBRECNO=$O(^XTMP(IBDT,IBRECNO)) Q:+IBRECNO=0 D
. . ;create node and .01 for events multiple
. . I '$D(^XTMP(IBDT,IBRECNO,"CALL")) D ERRMSG(" there is no CALL node in ^XTMP") Q
. . ;Add event (CALL) = ^XTMP(IBDT,IBRECNO,"CALL")
. . S IBCALVAL=$G(^XTMP(IBDT,IBRECNO,"CALL"))
. . I $$ADDEVENT(IBDATE,IBRECNO,IBCALVAL)<0 D ERRMSG(" EVENT entry wasn't created for "_IBCALVAL) Q
. . ;quit if was not created
. . S IBTYPE=""
. . ;Loop through fields...
. . F S IBTYPE=$O(^XTMP(IBDT,IBRECNO,IBTYPE)) Q:IBTYPE="" D
. . . I IBTYPE="CALL" Q ;was already created
. . . ;fields general fields (other than IBD)
. . . I IBTYPE="DEVICE" Q ;we do not use DEVICE in new file
. . . I IBTYPE'="IBD" S IBRET=$$GENFLDS(IBDT,IBRECNO,IBTYPE,IBDATE) D:+IBRET=0 Q
. . . . D ERRMSG(" >"_IBTYPE_":"_$P(IBRET,U,2))
. . . ;if IBD fields
. . . S IBIBDTYP=""
. . . F S IBIBDTYP=$O(^XTMP(IBDT,IBRECNO,IBTYPE,IBIBDTYP)) Q:IBIBDTYP="" D
. . . . ; if Insurance
. . . . I IBIBDTYP="INS" S IBRET=$$INS(IBDT,IBRECNO,IBDATE) D:+IBRET=0 Q
. . . . . D ERRMSG(" >>INSURANCE node was not populated")
. . . . ; other IBD fields
. . . . S IBRET=$$IBD(IBDT,IBRECNO,IBIBDTYP,IBDATE)
. . . . D:+IBRET=0 ERRMSG(" >>IBD field "_IBIBDTYP_" was not populated")
;send e-mail about conversion completion
S IBMSG1="The conversion of data from the ^XTMP global array into the IB NCPDP"
S IBMSG2="EVENT LOG file has successfully completed."
D SNDMAIL("IB*2.0*342 installation has been completed",IBMSG1,IBMSG2)
Q
;process the fields common for all messages
GENFLDS(IBDT,IBRECNO,IBTYPE,IBDATE) ;
N IBVAL,IBFLDNO,IBDTIEN,IBRETV
S IBRETV=0
S IBVAL=$G(^XTMP(IBDT,IBRECNO,IBTYPE))
S IBDTIEN=+$O(^IBCNR(366.14,"B",IBDATE,0))
Q:+IBDTIEN=0 0
I IBTYPE="CALL" S IBFLDNO=".01" G EDITFLD
I IBTYPE="DFN" S IBFLDNO=".03" G EDITFLD
I IBTYPE="JOB" S IBFLDNO=".04" G EDITFLD
I IBTYPE="TIME" S IBFLDNO=".05" G EDITFLD
I IBTYPE="USER" S IBFLDNO=".06" G EDITFLD
I IBTYPE="RESULT" D
. S IBRETV=+$$FILLFLDS^IBNCPUT1(366.141,".07",IBRECNO_","_IBDTIEN,+IBVAL)
. S IBRETV=+$$FILLFLDS^IBNCPUT1(366.141,".08",IBRECNO_","_IBDTIEN,$P(IBVAL,U,2))
Q IBRETV
EDITFLD ;
Q +$$FILLFLDS^IBNCPUT1(366.141,IBFLDNO,IBRECNO_","_IBDTIEN,IBVAL)
;---------
;store IBD array data
;input:
;IBDT -date node as it is in ^XTMP global, i.e. "IBNCPDP-3060214"
;IBRECNO -ien in [EVENTS] multiple
;IBIBDTYP -type subscript in IBD array (BILL, PAID, RESPONSE, etc)
;IBDATE -date
;Output:
;0 -failure
;1^record number - success
;
IBD(IBDT,IBRECNO,IBIBDTYP,IBDATE) ;
N IBVAL,IBFLDNO,IBDTIEN
S IBVAL=$G(^XTMP(IBDT,IBRECNO,"IBD",IBIBDTYP))
S IBDTIEN=$O(^IBCNR(366.14,"B",IBDATE,0))
Q:+IBDTIEN=0 0
I IBIBDTYP="AUTH #" S IBFLDNO=".11" G EDITIBD
I IBIBDTYP="BCID" S IBFLDNO=".12" G EDITIBD
I IBIBDTYP="CLAIMID" S IBFLDNO=".13" G EDITIBD
I IBIBDTYP="DFN" S IBFLDNO=".14" G EDITIBD
I IBIBDTYP="DIVISION" S IBFLDNO=".15" G EDITIBD
I IBIBDTYP="RESPONSE" S IBFLDNO=".16" G EDITIBD
I IBIBDTYP="REVERSAL REASON" S IBFLDNO=".17" G EDITIBD
I IBIBDTYP="RTS-DEL" S IBFLDNO=".18" G EDITIBD
I IBIBDTYP="STATUS" S IBFLDNO=".19" G EDITIBD
I IBIBDTYP="RX NO" S IBFLDNO=".202" G EDITIBD
I IBIBDTYP="FILL NUMBER" S IBFLDNO=".203" G EDITIBD
I IBIBDTYP="DRUG" S IBFLDNO=".204" G EDITIBD
I IBIBDTYP="NDC" S IBFLDNO=".205" G EDITIBD
I IBIBDTYP="FILL DATE" S IBFLDNO=".206" G EDITIBD
I IBIBDTYP="RELEASE DATE" S IBFLDNO=".207" G EDITIBD
I IBIBDTYP="QTY" S IBFLDNO=".208" G EDITIBD
I IBIBDTYP="DAYS SUPPLY" S IBFLDNO=".209" G EDITIBD
I IBIBDTYP="DEA" S IBFLDNO=".21" G EDITIBD
I IBIBDTYP="FILLED BY" S IBFLDNO=".211" G EDITIBD
I IBIBDTYP="AO" S IBFLDNO=".401" G EDITIBD
I IBIBDTYP="CV" S IBFLDNO=".402" G EDITIBD
I IBIBDTYP="EC" S IBFLDNO=".403" G EDITIBD
I IBIBDTYP="IR" S IBFLDNO=".404" G EDITIBD
I IBIBDTYP="MST" S IBFLDNO=".405" G EDITIBD
I IBIBDTYP="HNC" S IBFLDNO=".406" G EDITIBD
I IBIBDTYP="SC" S IBFLDNO=".407" G EDITIBD
I IBIBDTYP="BILL" S IBFLDNO=".301" G EDITIBD
I IBIBDTYP="BILLED" S IBFLDNO=".302" G EDITIBD
I IBIBDTYP="PLAN" S IBFLDNO=".303" G EDITIBD
I IBIBDTYP="COST" S IBFLDNO=".304" G EDITIBD
I IBIBDTYP="PAID" S IBFLDNO=".305" G EDITIBD
I IBIBDTYP="CLOSE COMMENT" S IBFLDNO=".306" G EDITIBD
I IBIBDTYP="CLOSE REASON" S IBFLDNO=".307" G EDITIBD
I IBIBDTYP="DROP TO PAPER" S IBFLDNO=".308" G EDITIBD
I IBIBDTYP="RELEASE COPAY" S IBFLDNO=".309" G EDITIBD
I IBIBDTYP="USER" S IBFLDNO=".31" G EDITIBD
I IBIBDTYP="PRESCRIPTION" S IBFLDNO=".201" G EDITIBD
I IBIBDTYP="IEN" S IBFLDNO=".212" G EDITIBD
Q 0
EDITIBD ;
Q +$$FILLFLDS^IBNCPUT1(366.141,IBFLDNO,IBRECNO_","_IBDTIEN,IBVAL)
;------
;
; IBD("INS",n,1) = insurance array to bill in n order
; file 355.3 ien (group)^bin^pcn^payer sheet B1^group id^
; cardholder id^patient relationship code^
; cardholder first name^cardholder last name^
; home plan state^Payer Sheet B2^Payer Sheet B3^
; Software/Vendor Cert ID^Ins Name^
; (see RX^IBNCPDP1 for details)
;
; ("INS",n,2) = dispensing fee^basis of cost determination^
; awp or tort rate or cost^gross amount due^
; administrative fee
;
; ("INS",n,3) = group name^insurance phone number^plan ID ;
;
INS(IBDT,IBRECNO,IBDATE) ;
N IBSET1,IBSET2,IBSET3,IBFLDNO,IBDTIEN,IBINSNO,RECNO,IBVAL
S IBDTIEN=$O(^IBCNR(366.14,"B",IBDATE,0))
Q:+IBDTIEN=0 0
S IBINSNO=0
F S IBINSNO=$O(^XTMP(IBDT,IBRECNO,"IBD","INS",IBINSNO)) Q:+IBINSNO=0 D
. S IBSET1=$G(^XTMP(IBDT,IBRECNO,"IBD","INS",IBINSNO,1))
. S IBSET2=$G(^XTMP(IBDT,IBRECNO,"IBD","INS",IBINSNO,2))
. S IBSET3=$G(^XTMP(IBDT,IBRECNO,"IBD","INS",IBINSNO,3))
. ;INS IBINSNO
. ; 1 IBSET1
. ; 2 IBSET2
. ; 3 IBSET3
. S RECNO=$$ADDINS^IBNCPLOG(IBDTIEN,IBRECNO)
. I +RECNO=0 D ERRMSG(" >INSURANCE node was not created") Q
. I +$$FILLFLDS^IBNCPUT1(366.1412,.02,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,1))
. I +$$FILLFLDS^IBNCPUT1(366.1412,.03,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,2))
. I +$$FILLFLDS^IBNCPUT1(366.1412,.04,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,3))
. I +$$FILLFLDS^IBNCPUT1(366.1412,.05,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,4))
. I +$$FILLFLDS^IBNCPUT1(366.1412,.06,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,5))
. I +$$FILLFLDS^IBNCPUT1(366.1412,.07,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,6))
. I +$$FILLFLDS^IBNCPUT1(366.1412,.08,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,7))
. ;
. I +$$FILLFLDS^IBNCPUT1(366.1412,.101,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,8))
. I +$$FILLFLDS^IBNCPUT1(366.1412,.102,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,9))
. I +$$FILLFLDS^IBNCPUT1(366.1412,.103,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,10))
. I +$$FILLFLDS^IBNCPUT1(366.1412,.104,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,11))
. I +$$FILLFLDS^IBNCPUT1(366.1412,.105,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,12))
. I +$$FILLFLDS^IBNCPUT1(366.1412,.106,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,13))
. I +$$FILLFLDS^IBNCPUT1(366.1412,.107,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,14))
. ;
. I +$$FILLFLDS^IBNCPUT1(366.1412,.201,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,1))
. I +$$FILLFLDS^IBNCPUT1(366.1412,.202,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,2))
. I +$$FILLFLDS^IBNCPUT1(366.1412,.203,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,3))
. I +$$FILLFLDS^IBNCPUT1(366.1412,.204,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,4))
. I +$$FILLFLDS^IBNCPUT1(366.1412,.205,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,5))
. ;
. I +$$FILLFLDS^IBNCPUT1(366.1412,.301,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET3,U,1))
. I +$$FILLFLDS^IBNCPUT1(366.1412,.302,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET3,U,2))
. I +$$FILLFLDS^IBNCPUT1(366.1412,.303,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET3,U,3))
Q RECNO
;
;create EVENT entry in #366.14
;IBDATE date in FM format
;EVNTRECN event recno required
;EVNTTYPE event type (value for .01)
;returns ien for the event
ADDEVENT(IBDATE,EVNTRECN,EVNTTYPE) ;
N IBIEN,IBX
S IBIEN=+$O(^IBCNR(366.14,"B",IBDATE,0))
I IBIEN=0 Q -1
Q $$INSITEM^IBNCPUT1(366.141,IBIEN,$$EXT2INT^IBNCPUT1(EVNTTYPE),EVNTRECN)
;
DELDATE(IBIEN) ;
N IBPDA,ERRARR
S IBPDA(366.14,IBIEN_",",.01)="@"
D FILE^DIE("","IBPDA","ERRARR")
I $D(ERRARR) Q "0^"_ERRARR("DIERR",1,"TEXT",1)
Q 1
;
;display error message
;IBERRMSG - error message text
ERRMSG(IBERRMSG) ;
D BMES^XPDUTL(IBERRMSG)
Q
;
;send mail to the user
SNDMAIL(IBSUBJ,IBMESS1,IBMESS2) ;
N DIFROM ;IMPORTANT - if you send e-mail from post-install !!!
N TMPARR,XMDUZ,XMSUB,XMTEXT,XMY
S TMPARR(1)=""
S TMPARR(2)=IBMESS1
S TMPARR(3)=IBMESS2
S TMPARR(4)=""
S XMSUB=IBSUBJ
S XMDUZ="INTEGRATED BILLING PACKAGE"
S XMTEXT="TMPARR("
S XMY(DUZ)=""
D ^XMD
Q
;
;IB20P342
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P342 9987 printed Sep 23, 2025@19:38:22 Page 2
IB20P342 ;DALOI/SS - IB ECME EVNT REPORT ;01/03/2006
+1 ;;2.0;INTEGRATED BILLING;**342**;21-MAR-94;Build 18
+2 ;; Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;;
+4 QUIT
+5 ;
+6 ;move data from ^XTMP("IBNCPDP-..." to file #366.14
EN ;
+1 NEW IBDT,IBRECNO,IBDATE,IBIBDTYP,IBRET,IBTYPE,IBDTIEN,IBCALVAL
+2 NEW IBMSG1,IBMSG2
+3 IF +$ORDER(^IBCNR(366.14,0))
Begin DoDot:1
+4 DO ERRMSG("Conversion of IB ECME EVNT REPORT data will not be done in this site")
+5 DO ERRMSG("since data have been already converted in the past.")
+6 ;send e-mail about post-install completion
+7 SET IBMSG1="The conversion of data from the ^XTMP global array into the IB NCPDP"
+8 SET IBMSG2="EVENT LOG file has been skipped as the data has already been converted."
+9 DO SNDMAIL("IB*2.0*342 installation has been completed",IBMSG1,IBMSG2)
End DoDot:1
QUIT
+10 SET IBDT="IBNCPDP-"
+11 FOR
SET IBDT=$ORDER(^XTMP(IBDT))
if IBDT'["IBNCPDP-"
QUIT
Begin DoDot:1
+12 SET IBRECNO=0
+13 SET IBDATE=+$PIECE(IBDT,"-",2)
+14 DO BMES^XPDUTL("Add date: "_IBDATE)
+15 SET IBDTIEN=$$ADDDATE^IBNCPLOG(IBDATE)
+16 IF +IBDTIEN=0
DO ERRMSG("Cannot create a DATE entry for "_IBDATE)
+17 FOR
SET IBRECNO=$ORDER(^XTMP(IBDT,IBRECNO))
if +IBRECNO=0
QUIT
Begin DoDot:2
+18 ;create node and .01 for events multiple
+19 IF '$DATA(^XTMP(IBDT,IBRECNO,"CALL"))
DO ERRMSG(" there is no CALL node in ^XTMP")
QUIT
+20 ;Add event (CALL) = ^XTMP(IBDT,IBRECNO,"CALL")
+21 SET IBCALVAL=$GET(^XTMP(IBDT,IBRECNO,"CALL"))
+22 IF $$ADDEVENT(IBDATE,IBRECNO,IBCALVAL)<0
DO ERRMSG(" EVENT entry wasn't created for "_IBCALVAL)
QUIT
+23 ;quit if was not created
+24 SET IBTYPE=""
+25 ;Loop through fields...
+26 FOR
SET IBTYPE=$ORDER(^XTMP(IBDT,IBRECNO,IBTYPE))
if IBTYPE=""
QUIT
Begin DoDot:3
+27 ;was already created
IF IBTYPE="CALL"
QUIT
+28 ;fields general fields (other than IBD)
+29 ;we do not use DEVICE in new file
IF IBTYPE="DEVICE"
QUIT
+30 IF IBTYPE'="IBD"
SET IBRET=$$GENFLDS(IBDT,IBRECNO,IBTYPE,IBDATE)
if +IBRET=0
Begin DoDot:4
+31 DO ERRMSG(" >"_IBTYPE_":"_$PIECE(IBRET,U,2))
End DoDot:4
QUIT
+32 ;if IBD fields
+33 SET IBIBDTYP=""
+34 FOR
SET IBIBDTYP=$ORDER(^XTMP(IBDT,IBRECNO,IBTYPE,IBIBDTYP))
if IBIBDTYP=""
QUIT
Begin DoDot:4
+35 ; if Insurance
+36 IF IBIBDTYP="INS"
SET IBRET=$$INS(IBDT,IBRECNO,IBDATE)
if +IBRET=0
Begin DoDot:5
+37 DO ERRMSG(" >>INSURANCE node was not populated")
End DoDot:5
QUIT
+38 ; other IBD fields
+39 SET IBRET=$$IBD(IBDT,IBRECNO,IBIBDTYP,IBDATE)
+40 if +IBRET=0
DO ERRMSG(" >>IBD field "_IBIBDTYP_" was not populated")
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+41 ;send e-mail about conversion completion
+42 SET IBMSG1="The conversion of data from the ^XTMP global array into the IB NCPDP"
+43 SET IBMSG2="EVENT LOG file has successfully completed."
+44 DO SNDMAIL("IB*2.0*342 installation has been completed",IBMSG1,IBMSG2)
+45 QUIT
+46 ;process the fields common for all messages
GENFLDS(IBDT,IBRECNO,IBTYPE,IBDATE) ;
+1 NEW IBVAL,IBFLDNO,IBDTIEN,IBRETV
+2 SET IBRETV=0
+3 SET IBVAL=$GET(^XTMP(IBDT,IBRECNO,IBTYPE))
+4 SET IBDTIEN=+$ORDER(^IBCNR(366.14,"B",IBDATE,0))
+5 if +IBDTIEN=0
QUIT 0
+6 IF IBTYPE="CALL"
SET IBFLDNO=".01"
GOTO EDITFLD
+7 IF IBTYPE="DFN"
SET IBFLDNO=".03"
GOTO EDITFLD
+8 IF IBTYPE="JOB"
SET IBFLDNO=".04"
GOTO EDITFLD
+9 IF IBTYPE="TIME"
SET IBFLDNO=".05"
GOTO EDITFLD
+10 IF IBTYPE="USER"
SET IBFLDNO=".06"
GOTO EDITFLD
+11 IF IBTYPE="RESULT"
Begin DoDot:1
+12 SET IBRETV=+$$FILLFLDS^IBNCPUT1(366.141,".07",IBRECNO_","_IBDTIEN,+IBVAL)
+13 SET IBRETV=+$$FILLFLDS^IBNCPUT1(366.141,".08",IBRECNO_","_IBDTIEN,$PIECE(IBVAL,U,2))
End DoDot:1
+14 QUIT IBRETV
EDITFLD ;
+1 QUIT +$$FILLFLDS^IBNCPUT1(366.141,IBFLDNO,IBRECNO_","_IBDTIEN,IBVAL)
+2 ;---------
+3 ;store IBD array data
+4 ;input:
+5 ;IBDT -date node as it is in ^XTMP global, i.e. "IBNCPDP-3060214"
+6 ;IBRECNO -ien in [EVENTS] multiple
+7 ;IBIBDTYP -type subscript in IBD array (BILL, PAID, RESPONSE, etc)
+8 ;IBDATE -date
+9 ;Output:
+10 ;0 -failure
+11 ;1^record number - success
+12 ;
IBD(IBDT,IBRECNO,IBIBDTYP,IBDATE) ;
+1 NEW IBVAL,IBFLDNO,IBDTIEN
+2 SET IBVAL=$GET(^XTMP(IBDT,IBRECNO,"IBD",IBIBDTYP))
+3 SET IBDTIEN=$ORDER(^IBCNR(366.14,"B",IBDATE,0))
+4 if +IBDTIEN=0
QUIT 0
+5 IF IBIBDTYP="AUTH #"
SET IBFLDNO=".11"
GOTO EDITIBD
+6 IF IBIBDTYP="BCID"
SET IBFLDNO=".12"
GOTO EDITIBD
+7 IF IBIBDTYP="CLAIMID"
SET IBFLDNO=".13"
GOTO EDITIBD
+8 IF IBIBDTYP="DFN"
SET IBFLDNO=".14"
GOTO EDITIBD
+9 IF IBIBDTYP="DIVISION"
SET IBFLDNO=".15"
GOTO EDITIBD
+10 IF IBIBDTYP="RESPONSE"
SET IBFLDNO=".16"
GOTO EDITIBD
+11 IF IBIBDTYP="REVERSAL REASON"
SET IBFLDNO=".17"
GOTO EDITIBD
+12 IF IBIBDTYP="RTS-DEL"
SET IBFLDNO=".18"
GOTO EDITIBD
+13 IF IBIBDTYP="STATUS"
SET IBFLDNO=".19"
GOTO EDITIBD
+14 IF IBIBDTYP="RX NO"
SET IBFLDNO=".202"
GOTO EDITIBD
+15 IF IBIBDTYP="FILL NUMBER"
SET IBFLDNO=".203"
GOTO EDITIBD
+16 IF IBIBDTYP="DRUG"
SET IBFLDNO=".204"
GOTO EDITIBD
+17 IF IBIBDTYP="NDC"
SET IBFLDNO=".205"
GOTO EDITIBD
+18 IF IBIBDTYP="FILL DATE"
SET IBFLDNO=".206"
GOTO EDITIBD
+19 IF IBIBDTYP="RELEASE DATE"
SET IBFLDNO=".207"
GOTO EDITIBD
+20 IF IBIBDTYP="QTY"
SET IBFLDNO=".208"
GOTO EDITIBD
+21 IF IBIBDTYP="DAYS SUPPLY"
SET IBFLDNO=".209"
GOTO EDITIBD
+22 IF IBIBDTYP="DEA"
SET IBFLDNO=".21"
GOTO EDITIBD
+23 IF IBIBDTYP="FILLED BY"
SET IBFLDNO=".211"
GOTO EDITIBD
+24 IF IBIBDTYP="AO"
SET IBFLDNO=".401"
GOTO EDITIBD
+25 IF IBIBDTYP="CV"
SET IBFLDNO=".402"
GOTO EDITIBD
+26 IF IBIBDTYP="EC"
SET IBFLDNO=".403"
GOTO EDITIBD
+27 IF IBIBDTYP="IR"
SET IBFLDNO=".404"
GOTO EDITIBD
+28 IF IBIBDTYP="MST"
SET IBFLDNO=".405"
GOTO EDITIBD
+29 IF IBIBDTYP="HNC"
SET IBFLDNO=".406"
GOTO EDITIBD
+30 IF IBIBDTYP="SC"
SET IBFLDNO=".407"
GOTO EDITIBD
+31 IF IBIBDTYP="BILL"
SET IBFLDNO=".301"
GOTO EDITIBD
+32 IF IBIBDTYP="BILLED"
SET IBFLDNO=".302"
GOTO EDITIBD
+33 IF IBIBDTYP="PLAN"
SET IBFLDNO=".303"
GOTO EDITIBD
+34 IF IBIBDTYP="COST"
SET IBFLDNO=".304"
GOTO EDITIBD
+35 IF IBIBDTYP="PAID"
SET IBFLDNO=".305"
GOTO EDITIBD
+36 IF IBIBDTYP="CLOSE COMMENT"
SET IBFLDNO=".306"
GOTO EDITIBD
+37 IF IBIBDTYP="CLOSE REASON"
SET IBFLDNO=".307"
GOTO EDITIBD
+38 IF IBIBDTYP="DROP TO PAPER"
SET IBFLDNO=".308"
GOTO EDITIBD
+39 IF IBIBDTYP="RELEASE COPAY"
SET IBFLDNO=".309"
GOTO EDITIBD
+40 IF IBIBDTYP="USER"
SET IBFLDNO=".31"
GOTO EDITIBD
+41 IF IBIBDTYP="PRESCRIPTION"
SET IBFLDNO=".201"
GOTO EDITIBD
+42 IF IBIBDTYP="IEN"
SET IBFLDNO=".212"
GOTO EDITIBD
+43 QUIT 0
EDITIBD ;
+1 QUIT +$$FILLFLDS^IBNCPUT1(366.141,IBFLDNO,IBRECNO_","_IBDTIEN,IBVAL)
+2 ;------
+3 ;
+4 ; IBD("INS",n,1) = insurance array to bill in n order
+5 ; file 355.3 ien (group)^bin^pcn^payer sheet B1^group id^
+6 ; cardholder id^patient relationship code^
+7 ; cardholder first name^cardholder last name^
+8 ; home plan state^Payer Sheet B2^Payer Sheet B3^
+9 ; Software/Vendor Cert ID^Ins Name^
+10 ; (see RX^IBNCPDP1 for details)
+11 ;
+12 ; ("INS",n,2) = dispensing fee^basis of cost determination^
+13 ; awp or tort rate or cost^gross amount due^
+14 ; administrative fee
+15 ;
+16 ; ("INS",n,3) = group name^insurance phone number^plan ID ;
+17 ;
INS(IBDT,IBRECNO,IBDATE) ;
+1 NEW IBSET1,IBSET2,IBSET3,IBFLDNO,IBDTIEN,IBINSNO,RECNO,IBVAL
+2 SET IBDTIEN=$ORDER(^IBCNR(366.14,"B",IBDATE,0))
+3 if +IBDTIEN=0
QUIT 0
+4 SET IBINSNO=0
+5 FOR
SET IBINSNO=$ORDER(^XTMP(IBDT,IBRECNO,"IBD","INS",IBINSNO))
if +IBINSNO=0
QUIT
Begin DoDot:1
+6 SET IBSET1=$GET(^XTMP(IBDT,IBRECNO,"IBD","INS",IBINSNO,1))
+7 SET IBSET2=$GET(^XTMP(IBDT,IBRECNO,"IBD","INS",IBINSNO,2))
+8 SET IBSET3=$GET(^XTMP(IBDT,IBRECNO,"IBD","INS",IBINSNO,3))
+9 ;INS IBINSNO
+10 ; 1 IBSET1
+11 ; 2 IBSET2
+12 ; 3 IBSET3
+13 SET RECNO=$$ADDINS^IBNCPLOG(IBDTIEN,IBRECNO)
+14 IF +RECNO=0
DO ERRMSG(" >INSURANCE node was not created")
QUIT
+15 IF +$$FILLFLDS^IBNCPUT1(366.1412,.02,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET1,U,1))
+16 IF +$$FILLFLDS^IBNCPUT1(366.1412,.03,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET1,U,2))
+17 IF +$$FILLFLDS^IBNCPUT1(366.1412,.04,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET1,U,3))
+18 IF +$$FILLFLDS^IBNCPUT1(366.1412,.05,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET1,U,4))
+19 IF +$$FILLFLDS^IBNCPUT1(366.1412,.06,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET1,U,5))
+20 IF +$$FILLFLDS^IBNCPUT1(366.1412,.07,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET1,U,6))
+21 IF +$$FILLFLDS^IBNCPUT1(366.1412,.08,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET1,U,7))
+22 ;
+23 IF +$$FILLFLDS^IBNCPUT1(366.1412,.101,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET1,U,8))
+24 IF +$$FILLFLDS^IBNCPUT1(366.1412,.102,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET1,U,9))
+25 IF +$$FILLFLDS^IBNCPUT1(366.1412,.103,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET1,U,10))
+26 IF +$$FILLFLDS^IBNCPUT1(366.1412,.104,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET1,U,11))
+27 IF +$$FILLFLDS^IBNCPUT1(366.1412,.105,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET1,U,12))
+28 IF +$$FILLFLDS^IBNCPUT1(366.1412,.106,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET1,U,13))
+29 IF +$$FILLFLDS^IBNCPUT1(366.1412,.107,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET1,U,14))
+30 ;
+31 IF +$$FILLFLDS^IBNCPUT1(366.1412,.201,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET2,U,1))
+32 IF +$$FILLFLDS^IBNCPUT1(366.1412,.202,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET2,U,2))
+33 IF +$$FILLFLDS^IBNCPUT1(366.1412,.203,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET2,U,3))
+34 IF +$$FILLFLDS^IBNCPUT1(366.1412,.204,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET2,U,4))
+35 IF +$$FILLFLDS^IBNCPUT1(366.1412,.205,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET2,U,5))
+36 ;
+37 IF +$$FILLFLDS^IBNCPUT1(366.1412,.301,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET3,U,1))
+38 IF +$$FILLFLDS^IBNCPUT1(366.1412,.302,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET3,U,2))
+39 IF +$$FILLFLDS^IBNCPUT1(366.1412,.303,RECNO_","_IBRECNO_","_IBDTIEN,$PIECE(IBSET3,U,3))
End DoDot:1
+40 QUIT RECNO
+41 ;
+42 ;create EVENT entry in #366.14
+43 ;IBDATE date in FM format
+44 ;EVNTRECN event recno required
+45 ;EVNTTYPE event type (value for .01)
+46 ;returns ien for the event
ADDEVENT(IBDATE,EVNTRECN,EVNTTYPE) ;
+1 NEW IBIEN,IBX
+2 SET IBIEN=+$ORDER(^IBCNR(366.14,"B",IBDATE,0))
+3 IF IBIEN=0
QUIT -1
+4 QUIT $$INSITEM^IBNCPUT1(366.141,IBIEN,$$EXT2INT^IBNCPUT1(EVNTTYPE),EVNTRECN)
+5 ;
DELDATE(IBIEN) ;
+1 NEW IBPDA,ERRARR
+2 SET IBPDA(366.14,IBIEN_",",.01)="@"
+3 DO FILE^DIE("","IBPDA","ERRARR")
+4 IF $DATA(ERRARR)
QUIT "0^"_ERRARR("DIERR",1,"TEXT",1)
+5 QUIT 1
+6 ;
+7 ;display error message
+8 ;IBERRMSG - error message text
ERRMSG(IBERRMSG) ;
+1 DO BMES^XPDUTL(IBERRMSG)
+2 QUIT
+3 ;
+4 ;send mail to the user
SNDMAIL(IBSUBJ,IBMESS1,IBMESS2) ;
+1 ;IMPORTANT - if you send e-mail from post-install !!!
NEW DIFROM
+2 NEW TMPARR,XMDUZ,XMSUB,XMTEXT,XMY
+3 SET TMPARR(1)=""
+4 SET TMPARR(2)=IBMESS1
+5 SET TMPARR(3)=IBMESS2
+6 SET TMPARR(4)=""
+7 SET XMSUB=IBSUBJ
+8 SET XMDUZ="INTEGRATED BILLING PACKAGE"
+9 SET XMTEXT="TMPARR("
+10 SET XMY(DUZ)=""
+11 DO ^XMD
+12 QUIT
+13 ;
+14 ;IB20P342
