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

IBCOMDT1.m

Go to the documentation of this file.
  1. IBCOMDT1 ;ALB/CKB - INSURANCE COMPANY MISSING DATA REPORT (COMPILE/PRINT) ; 12-APR-2023
  1. ;;2.0;INTEGRATED BILLING;**763**;21-MAR-94;Build 29
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;Selected Insurance Company(s):
  1. ; ^TMP(IBCOMDT("$J"),"PR",<insurance co name>,<insurance IEN>)=""
  1. ;
  1. ;
  1. ;Print data:
  1. ; ^TMP(IBCOMDT("$J"),"PR",<insurance co name>,<insurance IEN>)=DATA
  1. ;
  1. ; DATA=INSURANCE COMPANY ^ ADDRESS ON FILE ^ STREET LINE 1 ^ STREET LINE 2 ^ STREET LINE 3 ^
  1. ; CITY ^ STATE ^ ZIP+4 ^ TYPE OF COVERAGE ^ FILING TIME FRAME"
  1. ;
  1. ; ***Note: the pieces in DATA are set to 'YES' if they are missing data
  1. ;
  1. Q
  1. COMPILE(IBCNRTN,IBCOMDT) ; Entry Point called from EN^XUTMDEVQ (indirectly from IBCOMDT).
  1. ; IBCNRTN = Routine name for ^TMP(IBCNRTN,IBCOMDT("$J"),...
  1. ; IBCOMDT = Array of params
  1. ; Compile and Print Report
  1. N ADDRESS,CITY,DATA,FOUND,I,IBCT,IBPGN,INS,INSNM,SL1,SL2,SL3,ST,FTF,TYPCOV,ZIP,ZIP4
  1. K ^TMP(IBCOMDT("$J"),"PR")
  1. ;
  1. S IBCT=0
  1. S INSNM=0 F S INSNM=$O(^TMP(IBCNRTN,IBCOMDT("$J"),INSNM)) Q:INSNM="" D
  1. . S INS=0 F S INS=$O(^TMP(IBCNRTN,IBCOMDT("$J"),INSNM,INS)) Q:INS="" D
  1. . . ; Write '.' to the screen to keep session alive (logic from BLD^IBCNBLL)
  1. . . S IBCT=IBCT+1 I '$D(ZTQUEUED),'(IBCT#50) W "."
  1. . . ; Get Insurance Company field details
  1. . . S DATA=""
  1. . . S SL1=$$GET1^DIQ(36,INS_",",.111,"E")
  1. . . S SL2=$$GET1^DIQ(36,INS_",",.112,"E")
  1. . . S SL3=$$GET1^DIQ(36,INS_",",.113,"E")
  1. . . S CITY=$$GET1^DIQ(36,INS_",",.114,"E")
  1. . . ; Use State 2 digit abbreviation
  1. . . S ST=$$GET1^DIQ(5,$$GET1^DIQ(36,INS_",",.115,"I")_",",1)
  1. . . S ZIP=$$GET1^DIQ(36,INS_",",.116,"E"),ZIP4=""
  1. . . I $L(ZIP)>5 S ZIP4=$P(ZIP,"-",2)
  1. . . S ADDRESS=""
  1. . . I SL1'="" S ADDRESS=ADDRESS_SL1
  1. . . I SL2'="" S ADDRESS=ADDRESS_", "_SL2
  1. . . I SL3'="" S ADDRESS=ADDRESS_", "_SL3
  1. . . I CITY'="" S ADDRESS=ADDRESS_", "_CITY
  1. . . I ST'="" S ADDRESS=ADDRESS_", "_ST
  1. . . I ZIP'="" S ADDRESS=ADDRESS_", "_ZIP
  1. . . S TYPCOV=$$GET1^DIQ(36,INS_",",.13,"E")
  1. . . S FTF=$$FTFIC^IBCNEUT7(INS)
  1. . . ;
  1. . . ; Set DATA for Report output (filtered)
  1. . . I IBCOMDT("IBOUT")="R" S FOUND=0,DATA="" D
  1. . . . S $P(DATA,U,1)=ADDRESS
  1. . . . ; If there is missing data add it to DATA
  1. . . . I IBCOMDT("IBSL1") I SL1="" S $P(DATA,U,2)="YES"
  1. . . . I IBCOMDT("IBSL2") I SL2="" S $P(DATA,U,3)="YES"
  1. . . . I IBCOMDT("IBSL3") I SL3="" S $P(DATA,U,4)="YES"
  1. . . . I IBCOMDT("IBCTY") I CITY="" S $P(DATA,U,5)="YES"
  1. . . . I IBCOMDT("IBST") I ST="" S $P(DATA,U,6)="YES"
  1. . . . I IBCOMDT("IBZIP") I (ZIP4="")!(ZIP4="0000")!(ZIP4="9999") S $P(DATA,U,7)="YES"
  1. . . . I IBCOMDT("IBCOV") I TYPCOV="" S $P(DATA,U,8)="YES"
  1. . . . I IBCOMDT("IBFTF") I FTF["UNK" S $P(DATA,U,9)="YES"
  1. . . . F I=2:1:$L(DATA,U) I $P(DATA,U,I)'="" S FOUND=1
  1. . . ;
  1. . . ; Set DATA for Excel output (doesn't filter, includes all 8 fields)
  1. . . I IBCOMDT("IBOUT")="E" S FOUND=1,DATA="" D
  1. . . . S $P(DATA,U,1)=ADDRESS
  1. . . . S $P(DATA,U,2)=$S(SL1="":"YES",1:"NO")
  1. . . . S $P(DATA,U,3)=$S(SL2="":"YES",1:"NO")
  1. . . . S $P(DATA,U,4)=$S(SL3="":"YES",1:"NO")
  1. . . . S $P(DATA,U,5)=$S(CITY="":"YES",1:"NO")
  1. . . . S $P(DATA,U,6)=$S(ST="":"YES",1:"NO")
  1. . . . S $P(DATA,U,7)="NO"
  1. . . . I (ZIP4="")!(ZIP4="0000")!(ZIP4="9999") S $P(DATA,U,7)="YES"
  1. . . . S $P(DATA,U,8)=$S(TYPCOV="":"YES",1:"NO")
  1. . . . S $P(DATA,U,9)=$S(FTF["UNK":"YES",1:"NO")
  1. . . ;
  1. . . ; Add to ^TMP global for printing if missing data was found or Excel output
  1. . . I FOUND S ^TMP(IBCOMDT("$J"),"PR",INSNM,INS)=DATA
  1. . . K DATA
  1. K ^TMP(IBCNRTN,IBCOMDT("$J"))
  1. ;
  1. ; Print Excel or Report output
  1. D PRINT
  1. Q
  1. ;
  1. PRINT ; Print Report
  1. N CRT,CT,DASHES,DATA,EORMSG,IBHDT,IBPGC,IBQUIT,INS,LCT,NODATA,NONEMSG,MAXCNT,STOP,%
  1. S EORMSG="*** End of Report ***"
  1. S NONEMSG="*** NO DATA FOUND ***"
  1. S HDRNAME="INSURANCE COMPANY MISSING DATA"
  1. D NOW^%DTC
  1. S IBHDT=$$DAT2^IBOUTL($E(%,1,12))
  1. S (IBPGC,IBQUIT,LCT,STOP,ZSTOP)=0
  1. S $P(DASHES,"-",81)=""
  1. S MAXCNT=IOSL-2,CRT=1
  1. I 'IOST["C-" S MAXCNT=IOSL-6,CRT=0
  1. I IBCOMDT("IBOUT")="E" D EHDR
  1. I IBCOMDT("IBOUT")="R" D HEADER(HDRNAME,IBHDT)
  1. I '$D(^TMP(IBCOMDT("$J"),"PR")) W !,NONEMSG,! G PRINTQ ; NO DATA FOUND
  1. ;
  1. ; Loop through ^TMP(IBCOMDT("$J"),"PR") and display report output
  1. S INS=0 F S INS=$O(^TMP(IBCOMDT("$J"),"PR",INS)) Q:INS=""!(IBQUIT!$G(ZTSTOP)) D
  1. . S CT=0 F S CT=$O(^TMP(IBCOMDT("$J"),"PR",INS,CT)) Q:CT=""!(IBQUIT!$G(ZTSTOP)) D
  1. . . ; Excel output
  1. . . I IBCOMDT("IBOUT")="E" D
  1. . . . S DATA=^TMP(IBCOMDT("$J"),"PR",INS,CT)
  1. . . . W INS,U,$S($P(DATA,U,1)="":"<no address on file>",1:$P(DATA,U,1)),U
  1. . . . W $P(DATA,U,2,9),!
  1. . . ; Report output
  1. . . I IBCOMDT("IBOUT")="R" D REPORT
  1. ;
  1. PRINTQ ;
  1. ; Only display 'End of Report' and PAUSE if User didn't enter a '^' (IBQUIT=1)
  1. I '(IBQUIT!$G(ZTSTOP)) D
  1. . W !,EORMSG,!
  1. . D PAUSE
  1. I $D(ZTQUEUED) S ZTREQ="@" Q
  1. ; Close Device
  1. D ^%ZISC
  1. Q
  1. ;
  1. REPORT ; Report output
  1. N ADDOF,RPT1,RPT2,RPT3,RPT4
  1. ; Use Line counter (LCT) to keep all Insurance Company data on the same page
  1. S (RPT1,RPT2,RPT3,RPT4)=""
  1. S DATA=^TMP(IBCOMDT("$J"),"PR",INS,CT)
  1. S ADDOF=$P(DATA,U,1)
  1. ;
  1. ; Build line 1
  1. I $P(DATA,U,2)="YES" S RPT1=RPT1_$S(RPT1'="":", ",1:"")_"STREET LINE 1"
  1. I $P(DATA,U,3)="YES" S RPT1=RPT1_$S(RPT1'="":", ",1:"")_"STREET LINE 2"
  1. I $P(DATA,U,4)="YES" S RPT1=RPT1_$S(RPT1'="":", ",1:"")_"STREET LINE 3"
  1. I RPT1'="" S LCT=LCT+1
  1. ; Build line 2
  1. I $P(DATA,U,5)="YES" S RPT2=RPT2_$S(RPT2'="":", ",1:"")_"CITY"
  1. I $P(DATA,U,6)="YES" S RPT2=RPT2_$S(RPT2'="":", ",1:"")_"STATE"
  1. I $P(DATA,U,7)="YES" S RPT2=RPT2_$S(RPT2'="":", ",1:"")_"ZIP+4"
  1. I RPT2'="" S LCT=LCT+1
  1. ; Determine lines 3 and 4
  1. I $P(DATA,U,8)'="" S RPT3=1,LCT=LCT+1
  1. I $P(DATA,U,9)'="" S RPT4=1,LCT=LCT+1
  1. ;
  1. ;I ($Y+LCT)>MAXCNT D S LCT=0 Q:(IBQUIT!$G(ZTSTOP)) D HEADER(HDRNAME,IBHDT)
  1. I ($Y+LCT)>MAXCNT D S LCT=0 D HEADER(HDRNAME,IBHDT)
  1. . ;Write blank lines to fill page prior to displaying "Type <Enter> to continue or '^' to exit:"
  1. . I $E(IOST,1,2)["C-",MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
  1. I IBQUIT!$G(ZSTOP) Q
  1. ;
  1. ; Display results
  1. W !,INS,!
  1. W $S(ADDOF="":"<no address on file>",1:ADDOF),!
  1. I RPT1'="" W ?8,RPT1,!
  1. I RPT2'="" W ?8,RPT2,!
  1. I RPT3 W ?8,"TYPE OF COVERAGE",!
  1. I RPT4 W ?8,"FILING TIME FRAME",!
  1. Q
  1. ;
  1. ;
  1. N DIR,DTOUT,DUOUT,LIN,OFFSET,X,Y
  1. I IBPGC>0,$E(IOST,1,2)["C-" D Q:(IBQUIT!$G(ZTSTOP))
  1. . I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
  1. . D PAUSE
  1. I $E(IOST,1,2)'["C-",$$S^%ZTLOAD() S ZTSTOP=1 Q
  1. S IBPGC=IBPGC+1 I IBPGC>1!($E(IOST,1,2)["C-") W @IOF
  1. ; Excel and Report Header
  1. I IBCOMDT("IBOUT")="E",IBPGC=1 D EHDR
  1. I IBCOMDT("IBOUT")="R" D
  1. . W HDRNAME
  1. . S HDRDATE=HDRDATE_" Page: "_+IBPGC,OFFSET=(80-($L(HDRDATE)+1))
  1. . W ?OFFSET,HDRDATE,!
  1. . W "Missing Data: ",IBCOMDT("SUBHD"),!,DASHES,!
  1. Q
  1. ;
  1. EHDR ; Excel Header
  1. N EHDR
  1. S EHDR="INSURANCE COMPANY"_U_"ADDRESS ON FILE"_U_"STREET LINE 1"_U_"STREET LINE 2 "_U_"STREET LINE 3"
  1. S EHDR=EHDR_U_"CITY"_U_"STATE"_U_"ZIP+4"_U_"TYPE OF COVERAGE"_U_"FILING TIME FRAME"
  1. W !,HDRNAME,"^",IBHDT,!,"Missing Data: SEARCH ALL",!,"**YES indicates Missing Data**"
  1. W !!,EHDR,!
  1. Q
  1. ;
  1. PAUSE ; Pause for screen output.
  1. N DIR,DIRUT,DTOUT,DUOUT
  1. Q:$E(IOST,1,2)'["C-"
  1. S DIR(0)="E" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) S IBQUIT=1 K DIR,DIRUT,DTOUT,DUOUT
  1. Q