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

IBCNERPI.m

Go to the documentation of this file.
  1. IBCNERPI ;ALB/EJK - IBCNE EIV SECONDARY INSURANCE REPORT PRINT;08-APR-2013
  1. ;;2.0;INTEGRATED BILLING;**497**;08-APR-13;Build 120
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; variables from IBCNESI:
  1. ; IBCNERTN = "IBCNERPI"
  1. ; ^TMP($J,"IBCNESI1")
  1. ; IBCNESPC("TYPE")
  1. ; IBCOMP - FLAG FOR COMPLETED ENTRIES
  1. ; IBSDT - REPORT START DATE
  1. ; IBEDT - REPORT END DATE
  1. Q
  1. ;
  1. EN ; Entry point
  1. N DLINE,CRT,DFN,EORMSG,IBDFN,IBDOB,IBDT,IBEIEN,IBURTE,IBSTR1,IBSEQ,IBCNT
  1. S (IBPYR,RIEN,IBELG,IBDT,IBDFN,IBRIEN,IBEIEN)=""
  1. S (IBPGC,IBPXT)=0
  1. S NONEMSG="* * * N O D A T A F O U N D * * *"
  1. S EORMSG="*** END OF REPORT ***"
  1. ;S NPROC="Not Processed"
  1. S TSTAMP=$$FMTE^XLFDT($$NOW^XLFDT,1) ; time of report
  1. S TYPE=$G(IBCNESPC("TYPE")) ; report type
  1. S WIDTH=$S(TYPE="S":79,1:131)
  1. S IBSDT=$$FMTE^XLFDT(IBSDT,"5Z"),IBEDT=$$FMTE^XLFDT(IBEDT,"5Z")
  1. ; Determine IO parameters
  1. S MAXCNT=IOSL-6,CRT=0
  1. S:IOST["C-" MAXCNT=IOSL-3,CRT=1
  1. ; print data
  1. D HEADER I $G(ZTSTOP)!IBPXT Q
  1. ; If global does not exist - display No Data message
  1. I '$D(^TMP($J,"IBCNESI1")) D LINE($$FO^IBCNEUT1(NONEMSG,$$CENTER(NONEMSG),"R")) G EXIT
  1. F S IBDT=$O(^TMP($J,"IBCNESI1",IBDT)) Q:IBDT="" D Q:$G(ZTSTOP)!IBPXT
  1. .F S IBDFN=$O(^TMP($J,"IBCNESI1",IBDT,IBDFN)) Q:IBDFN="" D Q:$G(ZTSTOP)!IBPXT
  1. ..F S IBRIEN=$O(^TMP($J,"IBCNESI1",IBDT,IBDFN,IBRIEN)) Q:IBRIEN="" D Q:$G(ZTSTOP)!IBPXT
  1. ...D PTHDR Q:$G(ZTSTOP)!IBPXT
  1. ...F S IBEIEN=$O(^TMP($J,"IBCNESI1",IBDT,IBDFN,IBRIEN,"INS",IBEIEN)) Q:IBEIEN="" D PTDTL Q:$G(ZTSTOP)!IBPXT
  1. ...Q:$G(ZTSTOP)!IBPXT
  1. ...D PTCMT
  1. ...Q
  1. ..Q
  1. .Q
  1. I $G(ZTSTOP)!IBPXT Q
  1. ;
  1. EXIT ;
  1. D LINE($$FO^IBCNEUT1(EORMSG,$$CENTER(EORMSG),"R"))
  1. I CRT,IBPGC>0,'$D(ZTQUEUED) D EOL
  1. K IBCNESPC("TYPE"),IBELG,IBPGC,IBPXT,IBPYR,IBRIEN,MAXCNT,NONEMSG,RIEN,TSTAMP,TYPE,WIDTH,IBCOMP,IBEDT,IBSDT,IBSORT
  1. Q
  1. ;
  1. EOL ; display "end of page" message and set exit flag
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LIN
  1. I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
  1. S DIR(0)="E" D ^DIR K DIR
  1. I $D(DTOUT)!$D(DUOUT) S IBPXT=1
  1. Q
  1. ;
  1. N DASHES,HDR,OFFSET,SRT
  1. ;
  1. I CRT,IBPGC>0,'$D(ZTQUEUED) D EOL I IBPXT Q
  1. S TSTAMP=$$FMTE^XLFDT($$NOW^XLFDT,1) ; time of report
  1. I $D(ZTQUEUED),$$S^%ZTLOAD() S (ZTSTOP,IBPXT)=1 Q
  1. S IBPGC=IBPGC+1
  1. W @IOF,!,"Pt. Secondary Insurance Report"
  1. S HDR=TSTAMP_" Page: "_IBPGC,OFFSET=WIDTH-$L(HDR)
  1. W ?OFFSET,HDR,!
  1. I IBSORT="+1" W "Sort: Chronological Order"
  1. I IBSORT=-1 W "Sort: Reverse Chronological Order"
  1. S HDR=IBSDT_" - "_IBEDT
  1. S OFFSET=WIDTH-$L(HDR)
  1. W ?OFFSET,HDR,!
  1. W "Includes: "
  1. W $S(IBCOMP=3!(IBCOMP=4):"non-",1:""),"Completed Entries"
  1. W $S(IBCOMP=1!(IBCOMP=3):" without",1:" with")," associated comments"
  1. W !
  1. Q
  1. ;
  1. PTHDR ;HEADER FOR EACH PATIENT ENTRY
  1. N REVSTAT
  1. W !,$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"PATIENT NAME"))
  1. S IBDOB=$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"DOB"))
  1. I IBDOB>0 S IBDOB=17000000+IBDOB,IBDOB=$E(IBDOB,5,6)_"/"_$E(IBDOB,7,8)_"/"_$E(IBDOB,1,4)
  1. W " "_IBDOB
  1. S REVSTAT=$P($G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"REV STATUS")),U)
  1. W " Review Status: "_$S(REVSTAT=0:"Not Reviewed",REVSTAT=1:"In Process",REVSTAT=2:"Complete",1:"")
  1. S $P(DASHES,"-",WIDTH)="" D LINE(DASHES)
  1. Q
  1. ;
  1. PTDTL ;PRINT PATIENT DETAIL LINES
  1. S DLINE=IBDT*IBSORT,DLINE=$$FMTE^XLFDT(DLINE,"5Z") D LINE(DLINE)
  1. S DLINE=$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"EMFLAG"))_" "_$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"NAME")) D LINE(DLINE) Q:$G(ZTSTOP)!IBPXT
  1. I $G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ID"))]"" S DLINE=" Payer ID: "_$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ID")) D LINE(DLINE) Q:$G(ZTSTOP)!IBPXT
  1. I $G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ADDRESS 1"))]"" S DLINE=" "_$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ADDRESS 1")) D LINE(DLINE) Q:$G(ZTSTOP)!IBPXT
  1. I $G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ADDRESS 2"))]"" S DLINE=" "_$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ADDRESS 2")) D LINE(DLINE) Q:$G(ZTSTOP)!IBPXT
  1. S DLINE=" "
  1. S DLINE=DLINE_$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"CITY"))_", "
  1. S DLINE=DLINE_$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"STATE"))_" "
  1. S DLINE=DLINE_$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ZIP"))
  1. D LINE(DLINE) I $G(ZTSTOP)!IBPXT Q
  1. F IBURTE="TE","UR" D I $G(ZTSTOP)!IBPXT Q
  1. . S IBSEQ=0,IBSEQ=$O(^TMP($J,"IBCNESI2",IBRIEN,"INS",IBEIEN,IBURTE,IBSEQ)) Q:'IBSEQ
  1. . S IBSTR1=$S(IBURTE="TE":"Phone: ",1:"Website: ")_^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,IBURTE,IBSEQ) D WRAP^IBCNESI2(.IBSTR1,70)
  1. . F IBCNT=1:1:$O(IBSTR1(""),-1) S DLINE=" "_IBSTR1(IBCNT) D LINE(DLINE) I $G(ZTSTOP)!IBPXT Q
  1. . Q
  1. I '$G(ZTSTOP)&'IBPXT D LINE("")
  1. Q
  1. PTCMT ; print comments
  1. ; print comments
  1. N DIWF,DIWL,DIWR,IBCMDT,IBCMIEN,IBLN,IBRVIEN,IENS,X
  1. I '+$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"NO CMNT")) D
  1. .D LINE("") I $G(ZTSTOP)!IBPXT Q
  1. .D LINE("Comments:") I $G(ZTSTOP)!IBPXT Q
  1. .D LINE("") I $G(ZTSTOP)!IBPXT Q
  1. .S IBRVIEN=+$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"REV IEN"))
  1. .I '$D(^IBCN(365.2,IBRVIEN,1)) D LINE(" No Comments Entered."),LINE("") Q
  1. .S IBCMDT="" F S IBCMDT=$O(^IBCN(365.2,IBRVIEN,1,"B",IBCMDT),-1) Q:'IBCMDT!$G(ZTSTOP)!IBPXT D
  1. ..S IBCMIEN=$O(^IBCN(365.2,IBRVIEN,1,"B",IBCMDT,"")) I IBCMIEN="" Q
  1. ..S IENS=IBCMIEN_","_IBRVIEN_","
  1. ..S DLINE=$$FMTE^XLFDT($$GET1^DIQ(365.21,IENS,.01),"5Z")_" Entered by: "_$$GET1^DIQ(365.21,IENS,.02)
  1. ..D LINE(DLINE) I $G(ZTSTOP)!IBPXT Q
  1. ..K ^UTILITY($J,"W")
  1. ..F IBLN=1:1:$P($G(^IBCN(365.2,IBRVIEN,1,IBCMIEN,1,0)),U,3) S X=$G(^IBCN(365.2,IBRVIEN,1,IBCMIEN,1,IBLN,0)),DIWL=1,DIWR=70,DIWF="" D ^DIWP
  1. ..I $D(^UTILITY($J,"W")) S IBLN=0 F S IBLN=$O(^UTILITY($J,"W",1,IBLN)) Q:'IBLN!$G(ZTSTOP)!IBPXT D
  1. ...S DLINE=" "_$G(^UTILITY($J,"W",1,IBLN,0)) D LINE(DLINE)
  1. ...Q
  1. ..I '$G(ZTSTOP),'IBPXT,$O(^IBCN(365.2,IBRVIEN,1,"B",IBCMDT),-1)'="" D LINE("")
  1. ..Q
  1. .D LINE("") ; blank line before next person
  1. .Q
  1. K ^UTILITY($J,"W")
  1. Q
  1. ;
  1. LINE(LINE) ; Print line of data
  1. I $Y+1>MAXCNT D HEADER I $G(ZTSTOP)!IBPXT Q
  1. W !,?1,LINE
  1. Q
  1. ;
  1. CENTER(LINE) ; return length of a centered line
  1. ; LINE - line to center
  1. N LENGTH,OFFSET
  1. S LENGTH=$L(LINE),OFFSET=IOM-$L(LINE)\2
  1. Q OFFSET+LENGTH