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

ABSPOSRZ.m

Go to the documentation of this file. 
  1. ABSPOSRZ  ;IHS/OIT/SCR - REJECTION REPORT BY REJECTION REASON
  1.  ;;1.0;PHARMACY POINT OF SALE;**29,30,34,35,39,40,41,44,46**;JUN 21, 2001;Build 38
  1.  ;IHS/OIT/CNI/RAN - Rewritten for patch 40 to run WITHOUT Report Master
  1.  ;OIT/CAS/RCS - Fix report to look at only latest claim data not earlier claims, patch 44
  1.  ;IHS/OIT/RCS - Fix program error when Reject code is not in table, patch 46
  1.  ;IHS/OIT/RCS - Change ABSPCLMS variable to scratch file to fix STORE errors, patch 46
  1. EN ; EP
  1.  N ABSPQUIT,ABSPDONE,ABSPSTRT,ABSPEND,ABSPLCNT,ABSPREJ,ABSPRJ
  1.  I $D(ZTQPARAM) D START
  1.  S ABSPDONE=0
  1.  S ABSPQUIT=0
  1.  F  Q:ABSPDONE=1  D
  1.  .S ABSPSTRT=$$BDT^ABSPOSRU()
  1.  .I ABSPSTRT=-1 D
  1.  ..S ABSPQUIT=1
  1.  ..S ABSPDONE=1
  1.  .Q:ABSPQUIT
  1.  .S ABSPEND=$$EDT^ABSPOSRU()
  1.  .I ABSPEND=-1 D
  1.  ..S ABSPQUIT=1
  1.  ..S ABSPDONE=1
  1.  ..Q
  1.  .Q:ABSPQUIT
  1.  .I ABSPSTRT<0 S ABSPDONE=1 Q
  1.  .I ABSPEND<0 S ABSPDONE=1 Q
  1.  .S X2=ABSPSTRT,X1=ABSPEND D ^%DTC
  1.  .I X<0 D EN^DDIOL("Ending Date is BEFORE Beginning Date Please enter new dates","","!!,*7")
  1.  .I X>=0 S ABSPDONE=1
  1.  .Q
  1.  Q:ABSPQUIT
  1.  S ABSPQUIT=$$CLNC^ABSPOSRU()
  1.  Q:ABSPQUIT=-1
  1.  S ABSPQUIT=$$INS^ABSPOSUU()
  1.  Q:ABSPQUIT=-1
  1.  S ABSPQUIT=$$CODE^ABSPOSUU() ;IHS/OIT/SCR 092109 patch 34 - screen by selected reject code
  1.  Q:ABSPQUIT=-1
  1.  S ABSPQUIT=$$RTYPE()
  1.  Q
  1. RTYPE()  ; SELECT IF YOU WANT SUMMARY, OR DETAILED
  1.  N DIR,STARTIME,STOPTIME
  1.  S DIR(0)="S^S:SUMMARY;D:DETAILED"
  1.  S DIR("B")="D"
  1.  S DIR("A")="Please select S for Summary or D for Detailed"
  1.  D ^DIR
  1.  I $D(DIRUT) Q -1
  1.  S ABSPRTYP=X ; SET REPORT TYPE
  1.  D DEVSEL^ABSPOSRU
  1.  D ^XBCLS
  1.  S STARTIME=$H
  1.  D FIND
  1.  S STOPTIME=$H
  1.  S ^TMP("ABSPOSRZ-RUNLOG",$J,STARTIME)=ABSPSTRT_"^"_$P(ABSPEND,".")_"^"_($P(STOPTIME,",",2)-$P(STARTIME,",",2))
  1.  D NEXT
  1.  Q 1
  1. FIND ; FIND REJECTIONS BY RELEASE DATE "B" CROSS REFERENCE
  1.  N ABSPDONE,ABSPRDT,ABSPCARD,ABSPGRP,ABSPCLMI,ABSPRCNT,ABSPRNUM,ABSPTRTM,ABSPRSMI,ABSPPRMI ;,ABSPCLMS
  1.  N ABSPTLTP,ABSPRESC,DO,ABSPIDTS,ABSPIDTE,ABSPIRMI,ABSPIRME
  1.  N ABSPCODE,ABSPQUIT ;IHS/OIT/SCR 082109 patch 34
  1.  K ^TMP($J,"ABSPCLMS") ;OIT/CAS/RCS 081213 Patch 46
  1.  S ABSPRDT=ABSPSTRT
  1.  S ABSPEND=ABSPEND_".99999999"
  1.  S ABSPDONE=0
  1.  F  S ABSPRDT=$O(^PSRX("AL",ABSPRDT)) Q:(ABSPRDT="")!(ABSPDONE)!(+ABSPRDT=0)  D
  1.  .I ABSPRDT>ABSPEND S ABSPDONE=1 Q
  1.  .S ^TMP("ABSPOSRZ",$J,$P(ABSPRDT,"."))=""
  1.  .S ABSPPRMI=""
  1.  .F  S ABSPPRMI=$O(^PSRX("AL",ABSPRDT,ABSPPRMI)) Q:ABSPPRMI=""  D
  1.  ..S ABSPIRME=ABSPPRMI
  1.  ..S ABSPIRMI=ABSPPRMI_".99999999"
  1.  ..F  S ABSPIRMI=$O(^ABSPTL("B",ABSPIRMI),-1) Q:(ABSPIRMI<ABSPIRME)!(ABSPIRMI="")  D
  1.  ...S ABSPTRNS=""
  1.  ...F  S ABSPTRNS=$O(^ABSPTL("B",ABSPIRMI,ABSPTRNS),-1) Q:ABSPTRNS=""  D  Q  ;OIT/CAS/RCS 06202012 Patch 44 - Quit after the oldest/first claim is looked at, HEAT # 71102
  1.  ....N ABSPTL
  1.  ....M ABSPTL(ABSPTRNS)=^ABSPTL(ABSPTRNS)
  1.  ....;DONT REPORT CLOSED CLAIMS
  1.  ....I +$P($G(ABSPTL(ABSPTRNS,9)),"^") S ^TMP($J,"ABSPCLMS",$P(ABSPIRMI,"."))="" Q  ;OIT/CAS/RCS - Patch 46, S ABSPCLMS($P(ABSPIRMI,"."))="" Q
  1.  ....S ABSPTLTP=ABSPTL(ABSPTRNS,0)
  1.  ....S ABSPRSMI=$P(ABSPTLTP,U,5) ;Response reference
  1.  ....S ABSPCLMI=$P(ABSPTLTP,U,4) ;Claim Reference
  1.  ....Q:(ABSPRSMI="")!(ABSPCLMI="")
  1.  ....S DO=$P(ABSPTLTP,U,9)  ;Position on claim(and response)
  1.  ....I '$D(^ABSPR(ABSPRSMI,1000,DO)) S DO=$$GETDO^ABSPOSUU(ABSPRSMI,$P(ABSPIRMI,"."))
  1.  ....Q:DO=""
  1.  ....;IHS/OIT/CASSEVERN/RAN 03/02/2011 patch 41 If there is a corrupted response just skip it rather than err out
  1.  ....Q:'$D(^ABSPR(ABSPRSMI,1000,DO,500))
  1.  ....I $P(^ABSPR(ABSPRSMI,1000,DO,500),U)'="R" S ^TMP($J,"ABSPCLMS",$P(ABSPIRMI,"."))="" ;OIT/CAS/RCS - Patch 46, S ABSPCLMS($P(ABSPIRMI,"."))="" ;We only care about rejects in this report
  1.  ....Q:$D(^TMP($J,"ABSPCLMS",$P(ABSPIRMI,".")))  ;OIT/CAS/RCS - Patch 46, Q:$D(ABSPCLMS($P(ABSPIRMI,".")))
  1.  ....S ABSPTINS=$P(ABSPTL(ABSPTRNS,1),U,6)
  1.  ....S ABSPPHM1=""
  1.  ....I ABSPINS'="ALL" Q:ABSPTINS'=ABSPINS  ;NOT SELECTED INSURER
  1.  ....I (ABSPPPHM'="ALL")&&($P(ABSPTL(ABSPTRNS,1),U,7)'=ABSPPPHM) Q  ;NOT SELECTED PHARMACY
  1.  ....S ABSPPHM1=ABSPPPHM
  1.  ....I ABSPPPHM="ALL" S ABSPPHM1=$P(ABSPTL(ABSPTRNS,1),U,7) ;SET PHARMACY
  1.  ....I ABSPPHM1="" Q
  1.  ....;IHS/OIT/SCR 082109 START changes patch 34
  1.  ....I '$D(^ABSPR(ABSPRSMI,1000,DO,511)) S (ABSPRNUM,ABSPREA)="UKN" ;Added to skip junk data in PMAA test area
  1.  ....E  D  ;IHS/OIT/RCS 080913 patch 46 If Reject code missing, create unkown Reject description
  1.  .....S ABSPRNUM=$P(^ABSPR(ABSPRSMI,1000,DO,511,1,0),U)
  1.  .....I '$D(^ABSPF(9002313.93,"B",ABSPRNUM)) S ABSPREA="Reject Code description not entered,See NCPDP Rejects" Q  ;IHS/OIT/RCS PATCH 46
  1.  .....S ABSPREA=$P(^ABSPF(9002313.93,$O(^ABSPF(9002313.93,"B",ABSPRNUM,"")),0),U,2)
  1.  ....I (ABSPREJ'="ALL")&&(ABSPREJX'=ABSPRNUM) S ABSPQUIT=1 Q
  1.  ....S ABSPGRP=""
  1.  ....S ABSPCARD=""
  1.  ....S ABSPCARD=$P($G(^ABSPC(ABSPCLMI,300)),U,2) ;TRANSACTION:CLAIM:Cardholder ID Number
  1.  ....S ABSPCARD=$E(ABSPCARD,3,$L(ABSPCARD)) ;STRIP THE 2 CHARACTER QUALIFIER
  1.  ....S ABSPGRP=$P($G(^ABSPC(ABSPCLMI,300)),U,1) ;TRANSACTION:CLAIM:Group Number
  1.  ....S ABSPGRP=$E(ABSPGRP,3,$L(ABSPGRP)) ;STRIP THE 2 CHARACTER QUALIFIER
  1.  ....S ABSPRCNT=$P($G(ABSPREAS(ABSPRNUM,ABSPPHM1)),U)+1
  1.  ....S ^TMP($J,"ABSPCLMS",$P(ABSPIRMI,"."))="" ;OIT/CAS/RCS - Patch 46, S ABSPCLMS($P(ABSPIRMI,"."))=""
  1.  ....S ABSPREAS(ABSPRNUM,ABSPPHM1)=ABSPRCNT_U_ABSPRNUM_":"_ABSPREA
  1.  ....S ^TMP("ABSPOSRZ",$J,$P(ABSPRDT,"."),ABSPPHM1,ABSPTINS,ABSPRNUM,ABSPIRMI)=ABSPREA_U_$P(ABSPTL(ABSPTRNS,5),U,5)_U_$P(ABSPTL(ABSPTRNS,0),U,6)_U_$P(ABSPTL(ABSPTRNS,1),U,6)_U_ABSPCARD_U_ABSPGRP_U_ABSPCLMI
  1.  Q
  1. NEXT ;WHAT TO DO NEXT
  1.  N ABSPSTOP,ABSPOUT
  1.  S (ABSPSTOP,ABSPOUT)=0
  1.  I $O(^TMP("ABSPOSRZ",$J,""))="" D
  1.  .D PRHDR
  1.  .W !!," NO REJECTIONS FOUND FOR THE SELECTED DATE(S)"
  1.  .D ZEND
  1.  .S ABSPSTOP=1
  1.  .Q
  1.  Q:ABSPSTOP
  1.  D SUM
  1.  D PRNTSUM
  1.  I ABSPOUT D ZEND  Q
  1.  I ABSPRTYP["D" D PRNTDTL
  1.  D ZEND
  1.  Q
  1. PRHDR ;PRINT HEADER
  1.  N ABSPFEDT,ABSPFBDT,Y
  1.  U IO W:$D(ABSPSUM) @IOF
  1.  S Y=ABSPSTRT
  1.  D DD^%DT
  1.  S ABSPFBDT=Y
  1.  S Y=$P(ABSPEND,".")
  1.  D DD^%DT
  1.  S ABSPFEDT=Y
  1.  W @IOF
  1.  W !,?19,"Pharmacy Point of Sale Rejection Report"
  1.  W !,?22,"Claims sorted by Rejection Reason"
  1.  W !?22,"From "_ABSPFBDT_" TO "_ABSPFEDT
  1.  W !?30,"***SUMMARY REPORT***",!
  1.  Q
  1. SUM ;PRINT SUMMARY PAGE AND TOTAL AMT PER EACH THAT WAS REJECTED
  1.  N ABSPPCNT,ABSPTMP
  1.  S ABSPSRDT=""
  1.  F  S ABSPSRDT=$O(^TMP("ABSPOSRZ",$J,ABSPSRDT)) Q:ABSPSRDT=""  D
  1.  .M ABSPTMP(ABSPSRDT)=^TMP("ABSPOSRZ",$J,ABSPSRDT)
  1.  .S ABSPSPHM=""
  1.  .F  S ABSPSPHM=$O(ABSPTMP(ABSPSRDT,ABSPSPHM)) Q:ABSPSPHM=""  D
  1.  ..S ABSPSTIN=""
  1.  ..F  S ABSPSTIN=$O(ABSPTMP(ABSPSRDT,ABSPSPHM,ABSPSTIN)) Q:ABSPSTIN=""  D
  1.  ...S ABSPSRNM=""
  1.  ...F  S ABSPSRNM=$O(ABSPTMP(ABSPSRDT,ABSPSPHM,ABSPSTIN,ABSPSRNM)) Q:ABSPSRNM=""  D
  1.  ....S ABSPSTTL=0,ABSPSRMI="",ABSPSTL1=0
  1.  ....F  S ABSPSRMI=$O(ABSPTMP(ABSPSRDT,ABSPSPHM,ABSPSTIN,ABSPSRNM,ABSPSRMI)) Q:ABSPSRMI=""  D
  1.  .....S ABSPSREA=$P(ABSPTMP(ABSPSRDT,ABSPSPHM,ABSPSTIN,ABSPSRNM,ABSPSRMI),U,1)
  1.  .....S ABSPPCNT=$P($G(ABSPREAS(""_ABSPSRNM_"",ABSPSPHM)),U)
  1.  .....S ABSPSTTL=ABSPSTTL+$P(ABSPTMP(ABSPSRDT,ABSPSPHM,ABSPSTIN,ABSPSRNM,ABSPSRMI),U,2)
  1.  ....S ABSPSTL1=ABSPSTTL+$P($G(ABSPSUM(ABSPSPHM,ABSPSRNM)),U,2)
  1.  ....S ABSPSUM(ABSPSPHM,ABSPSRNM)=ABSPSRNM_":"_ABSPSREA_U_ABSPSTL1_U_ABSPSTIN_U_ABSPPCNT
  1.  .K ABSPTMP
  1.  Q
  1. PRNTSUM ;PRINT THE SUMMARY REPORT
  1.  N ABSPGCNT,ABSPPCNT,ABSPSTOP,ABSPTMP
  1.  S ABSPSTOP=0
  1.  S ABSPPPHM=""
  1.  S ABSPRTOT=0
  1.  S ABSPPCNT=0
  1.  S ABSPGTOT=0
  1.  S ABSPGCNT=0
  1.  S ABSPBTOT=0
  1.  S ABSPSTOP=0
  1.  S ABSPQUIT=0
  1.  S ABSPOUT=0
  1.  D PRHDR
  1.  F  S ABSPPPHM=$O(ABSPSUM(ABSPPPHM)) Q:(ABSPPPHM="")!(ABSPSTOP)  D
  1.  .I ABSPOUT S ABSPSTOP=1 Q
  1.  .I ABSPPPHM=0 S ABSPPPHM=1
  1.  .S ABSPPHMN=$P(^ABSP(9002313.56,ABSPPPHM,0),U,1)
  1.  .;IHS/OIT/CNI/RAN 04272010 patch 39 - When printing to screen use paging.
  1.  .S ABSPOUT=$$WRITE^ABSPOSUU("!!,""PHARMACY: "",ABSPPHMN")
  1.  .Q:ABSPOUT
  1.  .S ABSPPRNM=""
  1.  .S ABSPRTOT=0
  1.  .S ABSPPCNT=0  ;IHS/OIT/SCR 110309 this is pharmacy count
  1.  .;IHS/OIT/CNI/RAN 05042010 patch 39 - When printing to screen use paging.
  1.  .S ABSPOUT=$$WRITE^ABSPOSUU("!?2,""REJECTION CODE: "",?58,""  TOTALED: "",?68,""  RX COUNT: """)
  1.  .Q:ABSPOUT
  1.  .F  S ABSPPRNM=$O(ABSPSUM(ABSPPPHM,ABSPPRNM)) Q:(ABSPPRNM="")!(ABSPSTOP)  D
  1.  ..I ABSPOUT S ABSPSTOP=1 Q
  1.  ..S ABSPDRTR=$P(ABSPSUM(ABSPPPHM,ABSPPRNM),U,1)
  1.  ..I ABSPDRTR'="" D
  1.  ...;IHS/OIT/CNI/RAN 04272010 patch 39 - When printing to screen, use paging.
  1.  ...S ABSPOUT=$$WRITE^ABSPOSUU("!?0,$P(ABSPSUM(ABSPPPHM,ABSPPRNM),U,1),?60,$J($FN($P(ABSPSUM(ABSPPPHM,ABSPPRNM),U,2),"","",2),7),?72,$P(ABSPSUM(ABSPPPHM,ABSPPRNM),U,4)")
  1.  ...Q:ABSPOUT
  1.  ...S ABSPRTOT=ABSPRTOT+$P(ABSPSUM(ABSPPPHM,ABSPPRNM),U,2)
  1.  ...S ABSPPCNT=ABSPPCNT+$P(ABSPSUM(ABSPPPHM,ABSPPRNM),U,4)
  1.  ..Q:ABSPOUT
  1.  .Q:ABSPSTOP
  1.  .Q:ABSPOUT
  1.  .S ABSPGTOT=ABSPGTOT+ABSPRTOT
  1.  .S ABSPGCNT=ABSPGCNT+ABSPPCNT
  1.  .;IHS/OIT/CNI/RAN 04272010 patch 39 - When printing to screen use paging
  1.  .W:$Y<3 ! S ABSPOUT=$$WRITE^ABSPOSUU("!!,""TOTAL FOR PHARMACY: $"",$FN(ABSPRTOT,"","",2)")
  1.  .Q:ABSPOUT
  1.  .W:$Y<3 ! S ABSPOUT=$$WRITE^ABSPOSUU("!,""# RX REJECTED FOR PHARMACY: "",ABSPPCNT")
  1.  .Q:ABSPOUT
  1.  Q:ABSPSTOP
  1.  Q:ABSPOUT
  1.  ;IHS/OIT/CNI/RAN 04272010 patch 39 - When printing to screen, use paging
  1.  W:$Y<3 ! S ABSPOUT=$$WRITE^ABSPOSUU("!!,""GRAND TOTAL: $"",$FN(ABSPGTOT,"","",2)")
  1.  Q:ABSPOUT
  1.  W:$Y<3 ! S ABSPOUT=$$WRITE^ABSPOSUU("!,""# RX REJECTED: "",ABSPGCNT")
  1.  ;W:$Y<3 ! W !!,"P - Preventable, N - Non-recoverable, B - Both"
  1.  Q
  1. PRNTDHD ;PRINT DETAIL HEADER
  1.  I ABSPRTYP'["D" D ZEND Q
  1.  ;IHS/OIT/CNI/RAN 04272010 patch 39 - When printing to screen, use paging
  1.  S ABSPOUT=$$WRITE^ABSPOSUU("!!,?21,""********** Detailed Report **********"",!")
  1.  Q:ABSPOUT
  1.  S ABSPOUT=$$WRITE^ABSPOSUU("!,""CHT #"",?14,""NAME"",?32,""RX #/FILL # COBPayer"",?52,""INSURER"",?69,""AMT BILLED""")
  1.  Q:ABSPOUT
  1.  ;IHS/OIT/CNI/RAN 04282010 patch 39 - Add NDC # and Drug name
  1.  S ABSPOUT=$$WRITE^ABSPOSUU("!,?3,""CARD HOLDER ID #"",?27,""GROUP #"",?40,""NDC #"",?60,""DRUG NAME""")
  1.  Q
  1. PRNTDTL  ;PRINT DETAILED REPORT
  1.  N ABSPCARD,ABSPFRDT,ABSPGRP,ABSPSTOP,ABSPNDC,ABSPDRNM,ABSPQUIT,ABSPOUT,NDCDRG,ABSPCLMI,Y,ABSPTMP
  1.  S ABSPPRDT=""
  1.  S ABSPPPHM=""
  1.  S ABSPPRNM=""
  1.  ;IHS/OIT/CNI/RAN 04282010 patch 39 - Add NDC # and Drug name on next two lines and New line above
  1.  S ABSPNDC=""
  1.  S ABSPDRNM=""
  1.  S ABSPRTOT=0
  1.  S ABSPGTOT=0
  1.  S ABSPRDTL=0
  1.  S ABSPSTOP=0
  1.  S ABSPQUIT=0
  1.  S ABSPOUT=0
  1.  F  S ABSPPRDT=$O(^TMP("ABSPOSRZ",$J,ABSPPRDT)) Q:(ABSPPRDT="")!(ABSPQUIT)!(ABSPOUT)  D
  1.  .N ABSPTMP
  1.  .M ABSPTMP(ABSPPRDT)=^TMP("ABSPOSRZ",$J,ABSPPRDT)
  1.  .S ABSPPPHM=""
  1.  .S Y=ABSPPRDT
  1.  .D DD^%DT
  1.  .S ABSPFRDT=Y   ; FORMATTED RELEASE DATE
  1.  .S ABSPRDTL=0
  1.  .F  S ABSPPPHM=$O(ABSPTMP(ABSPPRDT,ABSPPPHM)) Q:(ABSPPPHM="")!(ABSPOUT)  D
  1.  ..S ABSPPINS=""
  1.  ..S ABSPPHMN=$P(^ABSP(9002313.56,ABSPPPHM,0),U,1)
  1.  ..D PRNTDHD
  1.  ..Q:ABSPOUT
  1.  ..;IHS/OIT/CNI/RAN 04272010 patch 39 - When printing to screen, use paging
  1.  ..S ABSPOUT=$$WRITE^ABSPOSUU("!!,?5,""PHARMACY: "",ABSPPHMN,""   RELEASED DATE: "",ABSPFRDT")
  1.  ..Q:ABSPOUT
  1.  ..S ABSPBTOT=0
  1.  ..F  S ABSPPINS=$O(ABSPTMP(ABSPPRDT,ABSPPPHM,ABSPPINS)) Q:(ABSPPINS="")!(ABSPOUT)  D
  1.  ...S ABSPPRNM=""
  1.  ...F  S ABSPPRNM=$O(ABSPTMP(ABSPPRDT,ABSPPPHM,ABSPPINS,ABSPPRNM)) Q:(ABSPPRNM="")!(ABSPOUT)  D
  1.  ....S ABSPPRMI=""
  1.  ....S ABSPRJCD=$P($G(ABSPREAS(""_ABSPPRNM_"",ABSPPPHM)),U,2)
  1.  ....;IHS/OIT/CNI/RAN 04272010 patch 39 - When printing to screen, use paging
  1.  ....S ABSPOUT=$$WRITE^ABSPOSUU("!!,?15,""REJECTION CODE: "",$E(ABSPRJCD,1,48)")
  1.  ....Q:ABSPOUT
  1.  ....F  S ABSPPRMI=$O(ABSPTMP(ABSPPRDT,ABSPPPHM,ABSPPINS,ABSPPRNM,ABSPPRMI)) Q:(ABSPPRMI="")!(ABSPOUT)  D
  1.  .....S (ABSPPCHT,ABSPPDIV,ABSPOPS)=""
  1.  .....S ABSPPTYP="P"
  1.  .....I $E($P(ABSPPRMI,".",2))=2 S ABSPPTYP="S"
  1.  .....I $E($P(ABSPPRMI,".",2))=3 S ABSPPTYP="T"
  1.  .....S ABSPPAT=$P(ABSPTMP(ABSPPRDT,ABSPPPHM,ABSPPINS,ABSPPRNM,ABSPPRMI),U,3)
  1.  .....S ABSPCARD=$P(ABSPTMP(ABSPPRDT,ABSPPPHM,ABSPPINS,ABSPPRNM,ABSPPRMI),U,5)
  1.  .....S ABSPGRP=$P(ABSPTMP(ABSPPRDT,ABSPPPHM,ABSPPINS,ABSPPRNM,ABSPPRMI),U,6)
  1.  .....S ABSPPATN=$E($P(^DPT(ABSPPAT,0),U,1),1,20)
  1.  .....S ABSPOPS=$P($G(^ABSP(9002313.56,ABSPPPHM,"OPSITE",1,0)),U,1)  ;OUTPATIENT SITE MIGHT NOT BE DEFINED
  1.  .....S:ABSPOPS'="" ABSPPDIV=$P($G(^PS(59,ABSPOPS,0)),U,6)  ;NO OUTPATIENT SITE MEANS NO DIVISION
  1.  .....S:ABSPPDIV'="" ABSPPCHT=$P($G(^AUPNPAT(ABSPPAT,41,ABSPPDIV,0)),U,2)  ;NO DIVISION MEANS NO CHART #
  1.  .....S ABSPPTP=$P(ABSPTMP(ABSPPRDT,ABSPPPHM,ABSPPINS,ABSPPRNM,ABSPPRMI),U,2)  ; PRICE
  1.  .....S ABSPINSN=$E($P($G(^AUTNINS(ABSPPINS,0)),U,1),1,22)   ; INSURER NAME
  1.  .....S ABSPCLMI=$P(ABSPTMP(ABSPPRDT,ABSPPPHM,ABSPPINS,ABSPPRNM,ABSPPRMI),U,7)
  1.  .....S ABSPPRX=$P(ABSPPRMI,".")  ;INTERNAL RX #
  1.  .....S ABSPPRXR=$P($P(^ABSPC(ABSPCLMI,400,$P(^ABSPC(ABSPCLMI,400,0),U,3),400),U,3),"D3",2)  ;Refill Number
  1.  .....;IHS/OIT/CNI/RAN 04282010 patch 39 - Add NDC # and Drug name BEGIN
  1.  .....S NDCDRG=$$GTNDCDRG^ABSPOSUU(ABSPCLMI,ABSPPRX)
  1.  .....S ABSPNDC=$P(NDCDRG,U,1)
  1.  .....S ABSPDRNM=$P(NDCDRG,U,2)
  1.  .....;IHS/OIT/CNI/RAN 04272010 patch 39 - When printing to screen, use paging
  1.  .....S ABSPOUT=$$WRITE^ABSPOSUU("!,ABSPPCHT,?9,ABSPPATN,?31,ABSPPRX_""/""_+ABSPPRXR_ABSPPTYP,?45,ABSPINSN,?70,""$""_$J(ABSPPTP,6,2)")
  1.  .....Q:ABSPOUT
  1.  .....;IHS/OIT/CNI/RAN 04282010 patch 39 - Add NDC # and Drug name
  1.  .....S ABSPOUT=$$WRITE^ABSPOSUU("!,?3,ABSPCARD,?27,ABSPGRP,?40,ABSPNDC,?60,ABSPDRNM")
  1.  .....Q:ABSPOUT
  1.  .....;IHS/OIT/CNI/RAN 04272010 patch 39 - When printing to screen, use paging.
  1.  .....S ABSBPRTT=ABSPRTOT+ABSPPTP
  1.  .....S ABSPBTOT=ABSPPTP+ABSPBTOT
  1.  .....S ABSPRDTL=ABSPRDTL+ABSPPTP
  1.  ...Q:ABSPOUT
  1.  ..Q:ABSPOUT
  1.  ..;IHS/OIT/CNI/RAN 04272010 patch 39 - When printing to screen, use paging
  1.  ..S ABSPOUT=$$WRITE^ABSPOSUU("!!,""TOTAL FOR "",ABSPPHMN,"": $"",$J($FN(ABSPBTOT,"","",2),6),!")
  1.  .Q:ABSPOUT
  1.  .;IHS/OIT/CNI/RAN 04272010 patch 39 - When printing to screen, use paging
  1.  .S ABSPOUT=$$WRITE^ABSPOSUU("!!,""TOTAL FOR RELEASED DATE "",ABSPFRDT,"": $"",$J($FN(ABSPRDTL,"","",2),6)")
  1.  .Q:ABSPOUT
  1.  .S ABSPGTOT=ABSPGTOT+ABSPRDTL
  1.  Q:ABSPSTOP
  1.  Q:ABSPOUT
  1.  ;IHS/OIT/CNI/RAN 04272010 patch 39 - When printing to screen, use paging
  1.  I $D(ABSPRTYP) S ABSPOUT=$$WRITE^ABSPOSUU("!!,""TOTAL AMOUNT REJECTED: $"",$J($FN(ABSPGTOT,"","",2),6),!!")
  1.  Q
  1. ZEND ;END AND KILL VARIABLES
  1.  D ^%ZISC
  1.  K ^TMP("ABSPOSRZ",$J),^TMP($J,"ABSPCLMS"),ABSPTMP,ABSPSUM,ABSBPRTT,ABSPBTOT,ABSPGTOT,ABSPRTOT,ABSPINS,ABSPPTP,ABSPPAT,ABSPPCHT,ABSPINSN,ABSPPRX,ABSPPRMI,ABSPPRXR,ABSPPDIV,ABSPOPS,ABSPPATN,ABSPPPHM,ABSPPRDT
  1.  K ABSPREAS,ABSPRMI,ABSPSRDT,ABSPSTTL,ABSPSRMI,ABSPSPHM,ABSPSRNM,RNUM,ABSPSTIN,ABSPFBDT,ABSPFEDT,ABSPBDT,ABSPEDT,ABSPTINS,ABSPTRNS,ABSPJ,ABSPRTYP,ABSPDRT,ABSPDRTR,ABSPRJCD
  1.  K ABSPPHM1,ABSPPHMN,ABSPPINS,ABSPPRNM,ABSPRCD,ABSPRDTL,ABSPREA,ABSPSREA,ABSPSTL1,ABSPSTRT
  1.  Q
  1. START  ;
  1.  N X,Y,ABSPJ,ABSPRJC,ABSPPAT,ABSPPIEN
  1.  I $D(ZTQPARAM) D
  1.  .I $P(ZTQPARAM,";",1)["T-1" S ABSPSTRT=DT-1
  1.  .I $P(ZTQPARAM,";",2)["T-1" S ABSPEND=DT-1
  1.  .S ABSPINS="ALL"
  1.  .S ABSPPPHM="ALL"
  1.  .S ABSPRTYP="D"
  1.  .D FIND
  1.  .D ZEND
  1.  .Q
  1.  Q