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
