| 1 | PSOCIDC2 ;BIR/LE-continuation of Copay Correction of erroneous billed copays ;11/8/05 12:50pm
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**226**;DEC 1997
|
|---|
| 3 | ;External reference to ^XUSEC supported by DBIA 10076
|
|---|
| 4 | ;External reference to IBARX supported by DBIA 125
|
|---|
| 5 | ;External reference to $$PROD^XUPROD(1) supported by DBIA 4440
|
|---|
| 6 | ;
|
|---|
| 7 | TOTAL ;
|
|---|
| 8 | N COUNT,COUNTED,UCOUNT,UCOUNTED,CCOUNT,CCOUNTED
|
|---|
| 9 | I '$D(PSOVETS) S PSOVETS=0
|
|---|
| 10 | N I,J
|
|---|
| 11 | F I=1:1:3 S (PSOCNT("YR2004",I),PSOCNT("YR2005",I),PSOCNT("YR2006",I))=0
|
|---|
| 12 | S PSODFN=0 F S PSODFN=$O(^XTMP(NAMSP,"TOT REL",PSODFN)) Q:'PSODFN D
|
|---|
| 13 | .S COUNTED=0
|
|---|
| 14 | .F J="YR2004","YR2005","YR2006" F I=1:1:3 S COUNT=$G(^XTMP(NAMSP,"TOT REL",PSODFN,J,I)) I COUNT>0 S:'$G(COUNTED) COUNTED=1,PSOVETS=PSOVETS+1 S PSOCNT(J,I)=PSOCNT(J,I)+COUNT
|
|---|
| 15 | F I=1:1:3 S PSOCNT=PSOCNT+$G(PSOCNT("YR2004",I))+$G(PSOCNT("YR2005",I))+$G(PSOCNT("YR2006",I))
|
|---|
| 16 | ;
|
|---|
| 17 | S (I,J)=-""
|
|---|
| 18 | I '$D(PSOCVETS) S PSOCVETS=0
|
|---|
| 19 | F I=1:1:3 S (PSOCCNT("YR2004",I),PSOCCNT("YR2005",I),PSOCCNT("YR2006",I))=0
|
|---|
| 20 | S PSODFN=0 F S PSODFN=$O(^XTMP(NAMSP,"TOT CAN",PSODFN)) Q:'PSODFN D
|
|---|
| 21 | .S CCOUNTED=0
|
|---|
| 22 | .F J="YR2004","YR2005","YR2006" F I=1:1:3 S CCOUNT=$G(^XTMP(NAMSP,"TOT CAN",PSODFN,J,I)) I CCOUNT>0 S:'$G(CCOUNTED) CCOUNTED=1,PSOCVETS=PSOCVETS+1 S PSOCCNT(J,I)=PSOCCNT(J,I)+CCOUNT
|
|---|
| 23 | F I=1:1:3 S PSOCCNT=PSOCCNT+$G(PSOCCNT("YR2004",I))+$G(PSOCCNT("YR2005",I))+$G(PSOCCNT("YR2006",I))
|
|---|
| 24 | ;
|
|---|
| 25 | S (I,J)=""
|
|---|
| 26 | I '$D(PSOUVETS) S PSOUVETS=0
|
|---|
| 27 | F I=1:1:3 S (PSOUCNT("YR2004",I),PSOUCNT("YR2005",I),PSOUCNT("YR2006",I))=0
|
|---|
| 28 | S PSOUDFN=0 F S PSOUDFN=$O(^XTMP(NAMSP,"TOT UNREL",PSOUDFN)) Q:'PSOUDFN D
|
|---|
| 29 | .S UCOUNTED=0
|
|---|
| 30 | .F J="YR2004","YR2005","YR2006" F I=1:1:3 S UCOUNT=$G(^XTMP(NAMSP,"TOT UNREL",PSOUDFN,J,I)) I UCOUNT>0 S:'$G(UCOUNTED) UCOUNTED=1,PSOUVETS=PSOUVETS+1 S PSOUCNT(J,I)=PSOUCNT(J,I)+UCOUNT
|
|---|
| 31 | F I=1:1:3 S PSOUCNT=PSOUCNT+$G(PSOUCNT("YR2004",I))+$G(PSOUCNT("YR2005",I))+$G(PSOUCNT("YR2006",I))
|
|---|
| 32 | ;
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | CHECK ;check for ICD and IB nodes
|
|---|
| 36 | ;
|
|---|
| 37 | N PSOREF,PSOIB,PSOOICD,PSOBILLD
|
|---|
| 38 | S PSOREF=YY
|
|---|
| 39 | S PSOOICD=$P($G(^PSRX(RXP,"ICD",1,0)),"^",2,8)
|
|---|
| 40 | ; see if bill already exists
|
|---|
| 41 | I PSOREF=0 D
|
|---|
| 42 | . I +$P($G(^PSRX(RXP,"IB")),"^",2)>0 D CHKIB^PSOCP1
|
|---|
| 43 | . S PSOREL=$P($G(^PSRX(RXP,2)),"^",13)
|
|---|
| 44 | I PSOREF>0 D
|
|---|
| 45 | . I +$G(^PSRX(RXP,1,PSOREF,"IB")) D CHKIB^PSOCP1
|
|---|
| 46 | . S PSOREL=$P($G(^PSRX(RXP,1,YY,0)),"^",18)
|
|---|
| 47 | I $G(PSOIB)=1!($G(PSOIB)=3) S PSOBILLD=1
|
|---|
| 48 | ; if billed/RELEASED and no IBQ node for both sc<50 and nsc
|
|---|
| 49 | I $G(PSOBILLD)&('$D(^PSRX(RXP,"IBQ"))) D
|
|---|
| 50 | . I $TR(PSOOICD,"^")[1 S ^XTMP(NAMSP,"CANCEL",PSODFN,RXP,YY)=$P(PSOREL,".")_"^"_PSODT_"^"_PSOSCP
|
|---|
| 51 | . I $TR(PSOOICD,"^")[0 S ^XTMP(NAMSP,"NOIBQ",PSODFN,RXP,YY)=$P(PSOREL,".")_"^"_PSODT_"^"_PSOSCP
|
|---|
| 52 | ; find unbilled ones with an ICD node and no IBQ node.
|
|---|
| 53 | I '$G(PSOBILLD)&('$D(^PSRX(RXP,"IBQ"))) D
|
|---|
| 54 | . Q:$TR(PSOOICD,"^")=""
|
|---|
| 55 | . S ^XTMP(NAMSP,"NOIBQ",PSODFN,RXP,YY)=$P(PSOREL,".")_"^"_PSODT_"^"_PSOSCP
|
|---|
| 56 | I YY S PSOTRF=PSOTRF+1
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | CANCEL ;Cancel erroneous copays/set IBQ node if not there
|
|---|
| 60 | ;released rx's
|
|---|
| 61 | N PSOCAP,PSODIV,PSODV,PSOFILL,PSOLOG,PSONAM,PSOOUT,PSOPAR,PSOPAR7,PSOSITE
|
|---|
| 62 | N PSOSITE7,PSOSQ,PSOTOT,PSOYEAR,PSOYR,SSN,SAVCPUN,SAVREF,PSOIB,PSOOIBQ,PSONIBQ,PSOOICD,PSOOIB
|
|---|
| 63 | N I,IFN,PSOANSQ,PSOTYP,COM,CC,PREA,PSONW,PSOOLD,PSOREL,PSO,PSOCPUN,PSOFLD,PSOTYPE,CANCEL
|
|---|
| 64 | S PSOTYPE="CAN"
|
|---|
| 65 | S PSODFN=0 F CC=1:1 S PSODFN=$O(^XTMP(NAMSP,"CANCEL",PSODFN)) Q:'PSODFN D Q:STOP
|
|---|
| 66 | .I CC#100=0,$D(^XTMP(NAMSP,0,"STOP")) D Q
|
|---|
| 67 | .. S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="STOP^"_$$NOW^XLFDT,STOP=1
|
|---|
| 68 | .S (PSOCAP(304),PSOCAP(305),PSOCAP(306))=0 ; INITIAL ANNUAL CAP FOR 2004 & 2005
|
|---|
| 69 | .F RXP=0:0 S RXP=$O(^XTMP(NAMSP,"CANCEL",PSODFN,RXP)) Q:'RXP D
|
|---|
| 70 | ..S (SAVCPUN,PSOCPUN)=($P(^PSRX(RXP,0),"^",8)+29)\30
|
|---|
| 71 | ..S YY="" F S YY=$O(^XTMP(NAMSP,"CANCEL",PSODFN,RXP,YY)) Q:YY="" D
|
|---|
| 72 | ...S (SAVREF,PSOREF)=YY
|
|---|
| 73 | ...; verify again that it was billed and not already cancelled
|
|---|
| 74 | ...S PSOBILLD=0
|
|---|
| 75 | ...I YY=0,+$P($G(^PSRX(RXP,"IB")),"^",2)>0 D CHKIB^PSOCP1 I $G(PSOIB)=1!($G(PSOIB)=3) S PSOBILLD=1
|
|---|
| 76 | ...I YY>0,+$P($G(^PSRX(RXP,1,PSOREF,"IB")),"^")>0 D CHKIB^PSOCP1 I $G(PSOIB)=1!($G(PSOIB)=3) S PSOBILLD=1
|
|---|
| 77 | ...Q:'PSOBILLD
|
|---|
| 78 | ...S PSOREL=$P($G(^XTMP(NAMSP,"CANCEL",PSODFN,RXP,YY)),"^"),PSOFLD=$P($G(^XTMP(NAMSP,"CANCEL",PSODFN,RXP,YY)),"^",2),PSOSCP=$P($G(^XTMP(NAMSP,"CANCEL",PSODFN,RXP,YY)),"^",3)
|
|---|
| 79 | ...S PSO=3 D NOW^%DTC S PSODT=%,PSODA=RXP,PSOCOMM="-BKGD CIDC COPAY CANCEL",PSOOLD="",PSONW="",PREA=""
|
|---|
| 80 | ...D CHKACT
|
|---|
| 81 | ...S PSOIB="",PSOIB=$S(PSOREF>0:$G(^PSRX(RXP,1,YY,"IB")),'PSOREF:$G(^PSRX(PSODA,"IB")),1:"")
|
|---|
| 82 | ...S (PSOOIBQ,PSOOICD,PSOOIB)=""
|
|---|
| 83 | ...S PSOOICD=$P($G(^PSRX(RXP,"ICD",1,0)),"^",2,8),PSOOIB=$G(^PSRX(RXP,"IB")),PSOOIBQ=$G(^PSRX(RXP,"IBQ"))
|
|---|
| 84 | ...I PSOOIBQ=""&($TR(PSOOICD,"^")[0!($TR(PSOOICD,"^")[1)) D SETIBQ
|
|---|
| 85 | ...D SITE S PSOCOMM="-BKGD CIDC COPAY CANCEL" D RXED^PSOCPA S:PSOOICD[1&($D(^PSRX(RXP,"IB"))) $P(^PSRX(RXP,"IB"),"^")=""
|
|---|
| 86 | ...S PSOCPUN=SAVCPUN,PSOREF=SAVREF
|
|---|
| 87 | ...D ACCUM
|
|---|
| 88 | ;
|
|---|
| 89 | ;ICD NODES WITHOUT IBQ NODE; set IBQ node but only set 1st piece of IB node if unreleased.
|
|---|
| 90 | S PSOTYP="IBQ"
|
|---|
| 91 | S PSODFN=0 F CC=1:1 S PSODFN=$O(^XTMP(NAMSP,"NOIBQ",PSODFN)) Q:'PSODFN D Q:STOP
|
|---|
| 92 | .I CC#100=0,$D(^XTMP(NAMSP,0,"STOP")) D Q
|
|---|
| 93 | .. S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="STOP^"_$$NOW^XLFDT,STOP=1
|
|---|
| 94 | .S (PSOCAP(304),PSOCAP(305),PSOCAP(306))=0 ; INITIAL ANNUAL CAP FOR 2004 & 2005
|
|---|
| 95 | .F RXP=0:0 S RXP=$O(^XTMP(NAMSP,"NOIBQ",PSODFN,RXP)) Q:'RXP D
|
|---|
| 96 | ..S (SAVCPUN,PSOCPUN)=($P(^PSRX(RXP,0),"^",8)+29)\30
|
|---|
| 97 | ..S YY="" F S YY=$O(^XTMP(NAMSP,"NOIBQ",PSODFN,RXP,YY)) Q:YY="" D
|
|---|
| 98 | ...S (SAVREF,PSOREF)=YY
|
|---|
| 99 | ...D SITE
|
|---|
| 100 | ...S PSOREL=$P($G(^XTMP(NAMSP,"NOIBQ",PSODFN,RXP,YY)),"^"),PSOFLD=$P($G(^XTMP(NAMSP,"NOIBQ",PSODFN,RXP,YY)),"^",2),PSOSCP=$P($G(^XTMP(NAMSP,"NOIBQ",PSODFN,RXP,YY)),"^",3)
|
|---|
| 101 | ...S (PSOOIBQ,PSOOICD,PSOOIB)=""
|
|---|
| 102 | ...S PSOOICD=$P($G(^PSRX(RXP,"ICD",1,0)),"^",2,8),PSOOIB=$G(^PSRX(RXP,"IB")),PSOOIBQ=$G(^PSRX(RXP,"IBQ"))
|
|---|
| 103 | ...I PSOOIBQ=""&($TR(PSOOICD,"^")[0!($TR(PSOOICD,"^")[1)) D SETIBQ D ;don't want to set again if already did it as part of copay cancel
|
|---|
| 104 | ....S I="",IFN=0 F I=0:0 S I=$O(^PSRX(RXP,"A",I)) Q:'I S IFN=I
|
|---|
| 105 | ....S COM=" BKGD CIDC UPDATE"
|
|---|
| 106 | ....D NOW^%DTC S IFN=IFN+1,^PSRX(RXP,"A",0)="^52.3DA^"_IFN_"^"_IFN,^PSRX(RXP,"A",IFN,0)=%_"^I^.5^"_YY_"^"_COM
|
|---|
| 107 | ....K DA
|
|---|
| 108 | ....S:PSOOICD[1&($D(^PSRX(RXP,"IB"))) $P(^PSRX(RXP,"IB"),"^")=""
|
|---|
| 109 | ...D:'$G(^XTMP(NAMSP,"CANCEL",PSODFN,RXP,YY)) ACCUM
|
|---|
| 110 | ...S PSOCPUN=SAVCPUN,PSOREF=SAVREF
|
|---|
| 111 | Q
|
|---|
| 112 | ;
|
|---|
| 113 | CHKACT ;check activity log for prev entry
|
|---|
| 114 | N ZACT,ZPSI,ZACTI
|
|---|
| 115 | S ZPSI=0 F S ZPSI=$O(^PSRX(PSODA,"COPAY",ZPSI)) Q:ZPSI="" S ZACTI="",ZACTI=$G(^PSRX(PSODA,"COPAY",ZPSI,0)) D Q:$G(ZACT)
|
|---|
| 116 | . I ZACTI["BKGD CIDC COPAY CANCEL"&($P(ZACTI,"^",2)="R") S PSOOLD="",PSONW="",PREA="C",ZACT=1 Q
|
|---|
| 117 | I '$G(ZACT) S PSOOLD="Copay",PSONW="No Copay",PREA="R" K PSOREF D ACTLOG^PSOCPA S PSOREF=YY,PSOOLD="",PSONW="",PREA="C"
|
|---|
| 118 | Q
|
|---|
| 119 | ;
|
|---|
| 120 | SETIBQ ; get data from IBQ node, set IBQ node, and 1st piece of IB node
|
|---|
| 121 | K PSOANSQ
|
|---|
| 122 | N PSONIBQ
|
|---|
| 123 | F PSOTYP=1:1:7 D
|
|---|
| 124 | . I PSOTYP=1 S PSOANSQ("VEH")=$P(PSOOICD,"^",PSOTYP)
|
|---|
| 125 | . I PSOTYP=2 S PSOANSQ("RAD")=$P(PSOOICD,"^",PSOTYP)
|
|---|
| 126 | . I PSOTYP=3 S PSOANSQ("SC")=$P(PSOOICD,"^",PSOTYP)
|
|---|
| 127 | . I PSOTYP=4 S PSOANSQ("PGW")=$P(PSOOICD,"^",PSOTYP)
|
|---|
| 128 | . I PSOTYP=5 S PSOANSQ("MST")=$P(PSOOICD,"^",PSOTYP)
|
|---|
| 129 | . I PSOTYP=6 S PSOANSQ("HNC")=$P(PSOOICD,"^",PSOTYP)
|
|---|
| 130 | . I PSOTYP=7 S PSOANSQ("CV")=$P(PSOOICD,"^",PSOTYP)
|
|---|
| 131 | S ^PSRX(RXP,"IBQ")=PSOANSQ("SC")_"^"_PSOANSQ("MST")_"^"_PSOANSQ("VEH")_"^"_PSOANSQ("RAD")_"^"_PSOANSQ("PGW")_"^"_PSOANSQ("HNC")_"^"_PSOANSQ("CV")
|
|---|
| 132 | Q
|
|---|
| 133 | ;
|
|---|
| 134 | ACCUM ; ACCUMULATE TOTALS
|
|---|
| 135 | S (PSOTOT,PSOYR,PSOYEAR,PSOLOG,PSONAM,PSOCHRG)=""
|
|---|
| 136 | ; get finished, but unreleased totals
|
|---|
| 137 | I PSOREL="" S PSOYR=$E(PSOFLD,1,3) Q:PSOYR="" D S PSOYEAR="" Q
|
|---|
| 138 | .S PSOYEAR=$S(PSOYR="304":"YR2004",PSOYR="305":"YR2005",PSOYR="306":"YR2006",1:"") Q:PSOYEAR=""
|
|---|
| 139 | .S PSOCHRG=7
|
|---|
| 140 | .I PSOYEAR="YR2006" S PSOCHRG=8
|
|---|
| 141 | .S PSOTOT=$G(^XTMP(NAMSP,"TOT UNREL",PSODFN,PSOYEAR))
|
|---|
| 142 | .S ^XTMP(NAMSP,"TOT UNREL",PSODFN,PSOYEAR)=PSOTOT+(PSOCPUN*PSOCHRG)
|
|---|
| 143 | .S ^XTMP(NAMSP,"TOT UNREL",PSODFN,PSOYEAR,PSOCPUN)=$G(^XTMP(NAMSP,"TOT UNREL",PSODFN,PSOYEAR,PSOCPUN))+1
|
|---|
| 144 | .S PSONAM=$P($G(^DPT(PSODFN,0)),"^"),PSONAM=$P(PSONAM,",")
|
|---|
| 145 | .S PSONAM=$E(PSONAM,1,6)
|
|---|
| 146 | .S ^XTMP(NAMSP,"IBQ UPD",PSONAM,PSODFN,RXP,PSOREF)=PSOFLD
|
|---|
| 147 | ;for released ones
|
|---|
| 148 | S PSOYR=$E(PSOREL,1,3)
|
|---|
| 149 | S:PSOYR'="" PSOYEAR=$S(PSOYR="304":"YR2004",PSOYR="305":"YR2005",PSOYR="306":"YR2006",1:"")
|
|---|
| 150 | Q:PSOYEAR=""
|
|---|
| 151 | S PSOCHRG=7
|
|---|
| 152 | I PSOYEAR="YR2006" S PSOCHRG=8
|
|---|
| 153 | ;
|
|---|
| 154 | ;get Xtmp billing amt which would be IBAM tot + any previous refills
|
|---|
| 155 | S PSOTOT=$G(^XTMP(NAMSP,"TOT REL",PSODFN,PSOYEAR))
|
|---|
| 156 | ;
|
|---|
| 157 | ;if none yet then init to the IBAM total for the year
|
|---|
| 158 | I 'PSOTOT D
|
|---|
| 159 | .F PSOSQ=0:0 S PSOSQ=$O(^IBAM(354.7,PSODFN,1,PSOSQ)) Q:'PSOSQ D
|
|---|
| 160 | ..S PSOLOG=$G(^IBAM(354.7,PSODFN,1,PSOSQ,0))
|
|---|
| 161 | ..I $E(PSOLOG,1,3)=PSOYR S PSOTOT=PSOTOT+$P(PSOLOG,"^",2)
|
|---|
| 162 | ;
|
|---|
| 163 | ;update Xtmp tot nodes with current fill amounts
|
|---|
| 164 | ; note: cancel copays and updated IBQ node released prescription are collected under TOT REL for the RPT^PSOCIDC3
|
|---|
| 165 | ; routine. Cancelled copays are denoted with an asterisk.
|
|---|
| 166 | S ^XTMP(NAMSP,"TOT REL",PSODFN,PSOYEAR)=PSOTOT+(PSOCPUN*PSOCHRG)
|
|---|
| 167 | S ^XTMP(NAMSP,"TOT REL",PSODFN,PSOYEAR,PSOCPUN)=$G(^XTMP(NAMSP,"TOT REL",PSODFN,PSOYEAR,PSOCPUN))+1
|
|---|
| 168 | ;
|
|---|
| 169 | ;indicate COPAY CANCEL for this fill
|
|---|
| 170 | ; ;by adding to Xtmp "BILLED"
|
|---|
| 171 | S PSONAM=$P($G(^DPT(PSODFN,0)),"^"),PSONAM=$P(PSONAM,",")
|
|---|
| 172 | S PSONAM=$E(PSONAM,1,6)
|
|---|
| 173 | S ^XTMP(NAMSP,"REL",PSONAM,PSODFN,RXP,PSOREF)=PSOREL
|
|---|
| 174 | ;
|
|---|
| 175 | CAN I PSOTYPE="CAN"&($G(^XTMP(NAMSP,"CANCEL",PSODFN,RXP,YY))) N PSOFILL S CANCEL="" S PSOFILL=YY D CHK^PSOCIDC3 I CANCEL D
|
|---|
| 176 | . S ^XTMP(NAMSP,"TOT CAN",PSODFN,PSOYEAR)=PSOTOT+(PSOCPUN*PSOCHRG)
|
|---|
| 177 | . S ^XTMP(NAMSP,"TOT CAN",PSODFN,PSOYEAR,PSOCPUN)=$G(^XTMP(NAMSP,"TOT CAN",PSODFN,PSOYEAR,PSOCPUN))+1
|
|---|
| 178 | Q
|
|---|
| 179 | ;
|
|---|
| 180 | SITE ; SET UP VARIABLES NEEDED BY BILLING
|
|---|
| 181 | S PSOSITE=$S(YY=0:$P(^PSRX(RXP,2),"^",9),1:$P($G(^PSRX(RXP,1,YY,0)),"^",9))
|
|---|
| 182 | Q:PSOSITE=""
|
|---|
| 183 | S PSOPAR=$G(^PS(59,PSOSITE,1))
|
|---|
| 184 | S PSOPAR7=$G(^PS(59,PSOSITE,"IB"))
|
|---|
| 185 | S PSOSITE7=$P($G(^PS(59,PSOSITE,"IB")),"^")
|
|---|
| 186 | Q
|
|---|
| 187 | ;
|
|---|
