- ABSPOSMH ; IHS/SD/RLT - POS Insurers with Missing Tax IDs ; [ 09/11/07 02:00 PM ]
- ;;1.0;PHARMACY POINT OF SALE;**22**;SEP 11, 2007;Build 38
- Q
- ;----------------------------------------------------------
- ;
- EN ;EP
- ;
- K ^TMP("ABSPOSMH",$J)
- W @IOF
- W "POS Insurers with Missing Tax IDs",!
- W !
- N POP D ^%ZIS Q:$G(POP)
- D GETDATA
- U IO
- D DISDATA
- D ^%ZISC
- K ^TMP("ABSPOSMH",$J)
- Q
- ;
- GETDATA ;
- N ABSPIIEN,ABSPRXST,ABSPTXID,ABSPFMT,ABSPINS
- N ABSPIA,ABSPIC,ABSPISI,ABSPISA,ABSPIZ,ABSPIP
- S ABSPIIEN=0
- F S ABSPIIEN=$O(^ABSPEI(ABSPIIEN)) Q:'+ABSPIIEN D
- . S ABSPRXST=$$GET1^DIQ(9999999.18,ABSPIIEN_",",.23,"I") ;rx status
- . Q:ABSPRXST'="P" ;quit if rx status is not P - BILLED POS
- . S ABSPTXID=$$GET1^DIQ(9999999.18,ABSPIIEN,.11)
- . Q:ABSPTXID'=""&(ABSPTXID?9N) ;don't report ins w/tax ids
- . S ABSPFMT=$$GET1^DIQ(9002313.4,ABSPIIEN_",",100.01) ;format
- . Q:ABSPFMT=""
- . S ABSPINS=$$GET1^DIQ(9999999.18,ABSPIIEN_",",.01) ;name
- . S ABSPIA=$$GET1^DIQ(9999999.18,ABSPIIEN_",",.02) ;address
- . S ABSPIC=$$GET1^DIQ(9999999.18,ABSPIIEN_",",.03) ;city
- . S ABSPISI=$$GET1^DIQ(9999999.18,ABSPIIEN_",",.04,"I") ;state ien
- . S ABSPISA=$$GET1^DIQ(5,ABSPISI_",",1) ;state abbr
- . S ABSPIZ=$$GET1^DIQ(9999999.18,ABSPIIEN_",",.05) ;zip
- . S ABSPIP=$$GET1^DIQ(9999999.18,ABSPIIEN_",",.06) ;phone
- . S ^TMP("ABSPOSMH",$J,ABSPINS,ABSPIIEN)=ABSPIA_"^"_ABSPIC_"^"_ABSPISA_"^"_ABSPIZ_"^"_ABSPIP_"^"_ABSPTXID
- Q
- DISDATA ;
- N DASHES
- S $P(DASHES,"-",81)=""
- N ABSPINS,ABSPIIEN,ABSPIREC,ABSPIA,ABSPIC,ABSPISA,ABSPIZ,ABSPIP
- D HEADING
- I '$D(^TMP("ABSPOSMH",$J)) D Q
- . W !,"No POS insurers with missing tax ids found!"
- . D ENDRPT^ABSPOSU5()
- S ABSPINS=""
- F S ABSPINS=$O(^TMP("ABSPOSMH",$J,ABSPINS)) Q:ABSPINS="" D
- . S ABSPIIEN=0
- . F S ABSPIIEN=$O(^TMP("ABSPOSMH",$J,ABSPINS,ABSPIIEN)) Q:'+ABSPIIEN D
- .. S ABSPIREC=$G(^TMP("ABSPOSMH",$J,ABSPINS,ABSPIIEN))
- .. S ABSPIA=$P(ABSPIREC,U) ;address
- .. S ABSPIC=$P(ABSPIREC,U,2) ;city
- .. S ABSPISA=$P(ABSPIREC,U,3) ;state abbr
- .. S ABSPIZ=$P(ABSPIREC,U,4) ;zip
- .. S ABSPIP=$P(ABSPIREC,U,5) ;phone
- .. S ABSPTXID=$P(ABSPIREC,U,6) ;invalid tax if not blank
- .. W !!,ABSPINS," (`",ABSPIIEN,")",?60,ABSPTXID
- .. W !,ABSPIA
- .. W !,ABSPIC,",",ABSPISA," ",ABSPIZ
- .. W !,ABSPIP
- .. I $$EOPQ^ABSPOSU8(3,,"D HEADING^"_$T(+0)) S ABSPINS="ZZZZZ"
- D ENDRPT^ABSPOSU5()
- W @IOF
- Q
- HEADING ;
- W @IOF
- N RPTDATE S RPTDATE=$$NOWEXT^ABSPOSU1
- W "POS Insurers with Missing Tax IDs (",$T(+0),")",?60,RPTDATE
- W !,DASHES
- Q
- ABSPOSMH ; IHS/SD/RLT - POS Insurers with Missing Tax IDs ; [ 09/11/07 02:00 PM ]
- +1 ;;1.0;PHARMACY POINT OF SALE;**22**;SEP 11, 2007;Build 38
- +2 QUIT
- +3 ;----------------------------------------------------------
- +4 ;
- EN ;EP
- +1 ;
- +2 KILL ^TMP("ABSPOSMH",$JOB)
- +3 WRITE @IOF
- +4 WRITE "POS Insurers with Missing Tax IDs",!
- +5 WRITE !
- +6 NEW POP
- DO ^%ZIS
- IF $GET(POP)
- QUIT
- +7 DO GETDATA
- +8 USE IO
- +9 DO DISDATA
- +10 DO ^%ZISC
- +11 KILL ^TMP("ABSPOSMH",$JOB)
- +12 QUIT
- +13 ;
- GETDATA ;
- +1 NEW ABSPIIEN,ABSPRXST,ABSPTXID,ABSPFMT,ABSPINS
- +2 NEW ABSPIA,ABSPIC,ABSPISI,ABSPISA,ABSPIZ,ABSPIP
- +3 SET ABSPIIEN=0
- +4 FOR
- SET ABSPIIEN=$ORDER(^ABSPEI(ABSPIIEN))
- IF '+ABSPIIEN
- QUIT
- Begin DoDot:1
- +5 ;rx status
- SET ABSPRXST=$$GET1^DIQ(9999999.18,ABSPIIEN_",",.23,"I")
- +6 ;quit if rx status is not P - BILLED POS
- IF ABSPRXST'="P"
- QUIT
- +7 SET ABSPTXID=$$GET1^DIQ(9999999.18,ABSPIIEN,.11)
- +8 ;don't report ins w/tax ids
- IF ABSPTXID'=""&(ABSPTXID?9N)
- QUIT
- +9 ;format
- SET ABSPFMT=$$GET1^DIQ(9002313.4,ABSPIIEN_",",100.01)
- +10 IF ABSPFMT=""
- QUIT
- +11 ;name
- SET ABSPINS=$$GET1^DIQ(9999999.18,ABSPIIEN_",",.01)
- +12 ;address
- SET ABSPIA=$$GET1^DIQ(9999999.18,ABSPIIEN_",",.02)
- +13 ;city
- SET ABSPIC=$$GET1^DIQ(9999999.18,ABSPIIEN_",",.03)
- +14 ;state ien
- SET ABSPISI=$$GET1^DIQ(9999999.18,ABSPIIEN_",",.04,"I")
- +15 ;state abbr
- SET ABSPISA=$$GET1^DIQ(5,ABSPISI_",",1)
- +16 ;zip
- SET ABSPIZ=$$GET1^DIQ(9999999.18,ABSPIIEN_",",.05)
- +17 ;phone
- SET ABSPIP=$$GET1^DIQ(9999999.18,ABSPIIEN_",",.06)
- +18 SET ^TMP("ABSPOSMH",$JOB,ABSPINS,ABSPIIEN)=ABSPIA_"^"_ABSPIC_"^"_ABSPISA_"^"_ABSPIZ_"^"_ABSPIP_"^"_ABSPTXID
- End DoDot:1
- +19 QUIT
- DISDATA ;
- +1 NEW DASHES
- +2 SET $PIECE(DASHES,"-",81)=""
- +3 NEW ABSPINS,ABSPIIEN,ABSPIREC,ABSPIA,ABSPIC,ABSPISA,ABSPIZ,ABSPIP
- +4 DO HEADING
- +5 IF '$DATA(^TMP("ABSPOSMH",$JOB))
- Begin DoDot:1
- +6 WRITE !,"No POS insurers with missing tax ids found!"
- +7 DO ENDRPT^ABSPOSU5()
- End DoDot:1
- QUIT
- +8 SET ABSPINS=""
- +9 FOR
- SET ABSPINS=$ORDER(^TMP("ABSPOSMH",$JOB,ABSPINS))
- IF ABSPINS=""
- QUIT
- Begin DoDot:1
- +10 SET ABSPIIEN=0
- +11 FOR
- SET ABSPIIEN=$ORDER(^TMP("ABSPOSMH",$JOB,ABSPINS,ABSPIIEN))
- IF '+ABSPIIEN
- QUIT
- Begin DoDot:2
- +12 SET ABSPIREC=$GET(^TMP("ABSPOSMH",$JOB,ABSPINS,ABSPIIEN))
- +13 ;address
- SET ABSPIA=$PIECE(ABSPIREC,U)
- +14 ;city
- SET ABSPIC=$PIECE(ABSPIREC,U,2)
- +15 ;state abbr
- SET ABSPISA=$PIECE(ABSPIREC,U,3)
- +16 ;zip
- SET ABSPIZ=$PIECE(ABSPIREC,U,4)
- +17 ;phone
- SET ABSPIP=$PIECE(ABSPIREC,U,5)
- +18 ;invalid tax if not blank
- SET ABSPTXID=$PIECE(ABSPIREC,U,6)
- +19 WRITE !!,ABSPINS," (`",ABSPIIEN,")",?60,ABSPTXID
- +20 WRITE !,ABSPIA
- +21 WRITE !,ABSPIC,",",ABSPISA," ",ABSPIZ
- +22 WRITE !,ABSPIP
- +23 IF $$EOPQ^ABSPOSU8(3,,"D HEADING^"_$TEXT(+0))
- SET ABSPINS="ZZZZZ"
- End DoDot:2
- End DoDot:1
- +24 DO ENDRPT^ABSPOSU5()
- +25 WRITE @IOF
- +26 QUIT
- HEADING ;
- +1 WRITE @IOF
- +2 NEW RPTDATE
- SET RPTDATE=$$NOWEXT^ABSPOSU1
- +3 WRITE "POS Insurers with Missing Tax IDs (",$TEXT(+0),")",?60,RPTDATE
- +4 WRITE !,DASHES
- +5 QUIT
