- 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 Mar 13, 2025@21:07:02 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
