PSO480P ;BIR/PC-Automatic Cancel of Copay charges for DOM ;03/02/17 10:30am
;;7.0;OUTPATIENT PHARMACY;**480**;DEC 1997;Build 35
;
;Reference to ^IB(350 supported by DBIA 2215
;
;This routine will run as a post-install for patch PSO*7*480
;and will loop through the prescription file by release date/time
;to find all prescriptions for patients logged in as inpatient
;assigned to a DOMICILIARY ward at release date of prescription.
;It will then cancel any copay that was charged by mistake with patch PSO*7*460 (FMCT)
; Both original and refills charges will be cancelled if needed.
;
;Detailed and summary reports will be sent to mailman at site.
Q
;
;going to need an entry point for when the routine is jobbed off during install
EN ;
N NAMSP,DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,QUIT,RUNOPT,JOBN,Y,YY,ZTSAVE,VAINDT,VAIN,TITLE,LIFE,BEGDT
S NAMSP="",NAMSP=$T(+0)
S LIFE=90,TITLE="FMCT Cancel DOMICILIARY Prescription Copay Charges - PSO*7*480"
S BEGDT=$$NOW^XLFDT(),PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
S ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_TITLE
S JOBN="FMCT DOMICILIARY CANCEL COPAYS"
L +^XTMP(NAMSP):0 I '$T D Q
. D BMES^XPDUTL(JOBN_" job is already running. Halting...")
. D MES^XPDUTL("")
. D QUIT
;
START ;
;initialize ^XTMP file according to SAC standard
;
S QUIT=0
;
I $G(^XTMP(NAMSP,0,"LAST"))["COMPLETED" D Q
. W !!,*7,"This job previously ran to completion on "
. W $$FMTE^XLFDT($P($G(^XTMP(NAMSP,0,"LAST")),"^",2)),!!
. D QUIT
;
;ques 2, if running from mumps prompt
S Y=$$NOW^XLFDT S ZTDTH=$$FMTH^XLFDT(Y)
;
;ques 2, if running from kids install
I $D(XPDQUES("POS2")) S ZTDTH=$$FMTH^XLFDT(XPDQUES("POS2"))
;
D BMES^XPDUTL("===================================================")
D MES^XPDUTL("Queuing background job to "_JOBN_"...")
D MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
D MES^XPDUTL("===================================================")
I $D(XPDQUES("POS2")) I ZTDTH="" D BMES^XPDUTL(JOBN_" NOT QUEUED") D QUIT Q
;
S:$D(^XTMP(NAMSP,0,"LAST")) ^XTMP(NAMSP,0,"ZAUDIT",$H)="RE-STARTED ON"_"^"_$$NOW^XLFDT_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
;
S ZTRTN="START1^PSO480P",ZTIO=""
S ZTDESC="Background job for "_JOBN_"."
S ZTSAVE("JOBN")="",ZTSAVE("NAMSP")=""
L -^XTMP(NAMSP)
D ^%ZTLOAD
D:$D(ZTSK)
. D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
. D BMES^XPDUTL("")
D BMES^XPDUTL("")
K XPDQUES
Q
;
QUIT ;
L -^XTMP(NAMSP)
K %,ZTSAVE,VAIN,PSO,PREA,PSOARBN,PSOAT,PSOBILLD,PSOCOMM,PSODA,PSODAYS,PSODT,PSOFILL1,PSOFLAG,PSOIBDAT,PSOINSTL,PSOISTAT,PSONML,PSONW,PSOOIB,PSOOLD,PSOIBN
K PSOINST,PSOPAR,PSOPAR7,PSORX,PSOSITE,PSOSITE7,PSOSTAT,PSOTAMT,PSOREF
Q
;
START1 ;
;initialize ^XTMP file according to SAC standard
N BEGDT,PURGDT,LIFE,NAMSP,PSOIB,CHKCAN,PSOSTART,PSOEND,PSOTDOL,PSOTRX,PSOTMRX,PSOTPAT,RXP,X,XX,JJ,PSORXE,PSOFILL,PSOFILL1,PSOREF
S NAMSP="",NAMSP=$T(+0)
D NOW^%DTC S Y=% D DD^%DT S PSOSTART=Y
S LIFE=90,TITLE="FMCT Cancel DOMICILIARY Prescription Copay Charges - PSO*7*480"
S BEGDT=$$NOW^XLFDT(),PURGDT=$$FMADD^XLFDT(BEGDT,LIFE),NAMSP=$T(+0)
K ^XTMP(NAMSP) S ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_TITLE
;
INST ;get first install date for FMCT patch PSO*7*460 which will be the begin date for checking for DOMICILIARY copay charges
N DATA,PSOINSTD,PSORDT,PSOEDT,PSODOM,PSODFN,DFN,PSODATA,POSIB,PSOIBN
S (X,XX,DATA)="",X=$$INSTALDT^XPDUTL("PSO*7.0*460",.DATA)
S PSOINSTD="",PSOINSTD=$O(DATA(PSOINSTD))
;
LOOP ;loop through AL cross reference
S:'$D(NAMSP) NAMSP=$T(+0)
S PSORDT=PSOINSTD\1-.00001,(RXP,PSOFILL)=""
F S PSORDT=$O(^PSRX("AL",PSORDT)) Q:PSORDT="" F S RXP=$O(^PSRX("AL",PSORDT,RXP)) Q:RXP="" D
. F S PSOFILL=$O(^PSRX("AL",PSORDT,RXP,PSOFILL)) Q:PSOFILL="" D
..S (PSODFN,DFN,PSODA)=$$GET1^DIQ(52,RXP,2,"I"),VAINDT=PSORDT
..S PSODOM=0 D INP^VADPT
..I $D(VAIN(4)),$D(^DIC(42,+VAIN(4),0)),$P(^(0),"^",3)="D" S PSODOM=1
..Q:'PSODOM ;not a DOMICILIARY
..S PSOREF=PSOFILL
..S PSOIB=0 D CHECK ;check if Rx is billed
..Q:'PSOIB ;if PSOIB=1 Rx is billed
..K PSODATA
..I PSOFILL=0 D ZERO
..I PSOFILL>0 D REFILL
..D GETIB ;retrieve IB Action file info and store in XTMP
..D CANCEL ;cancel copay
..D CHKCAN ;verify that cancel copay worked
D REPORT
D MAIL
Q
;
CHECK ;check IB nodes
; see if bill already exists - returned value of PSOIB1 means Rx is billed
I PSOFILL=0,+$P($G(^PSRX(RXP,"IB")),"^",2)>0 D CHKIB^PSOCP1
I PSOFILL>0,+$G(^PSRX(RXP,1,PSOFILL,"IB")) D CHKIB^PSOCP1
Q
;
ZERO ;
;get prescription information
D GETS^DIQ(52,RXP_",","3;31;106","I","PSODATA")
S:$G(PSODATA(52,RXP_",",3,"I")) PSOSTAT=PSODATA(52,RXP_",",3,"I")
S:$G(PSODATA(52,RXP_",",106,"I")) PSOIBN=PSODATA(52,RXP_",",106,"I")
Q
;
REFILL ;
D GETS^DIQ(52.1,PSOFILL_","_RXP_",",".01;3;9","I","PSODATA")
S:$G(PSODATA(52.1,PSOFILL_","_RXP_",",3,"I")) (DFN,PSODFN)=PSODATA(52.1,PSOFILL_","_RXP_",",3,"I")
S:$G(PSODATA(52.1,PSOFILL_","_RXP_",",9,"I")) PSOIBN=PSODATA(52.1,PSOFILL_","_RXP_",",9,"I")
Q
;
GETIB ;get billing information from IB Billing Action file #350
D GETS^DIQ(350,PSOIBN,".03;.05;.07;.11;.13","IE","PSOIBDAT")
S (PSOAT,PSOISTAT,PSOTAMT,PSOARBN,PSOINST)=""
S:$G(PSOIBDAT(350,PSOIBN_",",.03,"E"))'="" PSOAT=PSOIBDAT(350,PSOIBN_",",.03,"E") ;ACTION TYPE
S:$G(PSOIBDAT(350,PSOIBN_",",.05,"E"))'="" PSOISTAT=PSOIBDAT(350,PSOIBN_",",.05,"E") ;STATUS
S:$G(PSOIBDAT(350,PSOIBN_",",.07,"E"))'="" PSOTAMT=PSOIBDAT(350,PSOIBN_",",.07,"E") ;TOTAL CHARGE
S:$G(PSOIBDAT(350,PSOIBN_",",.11,"E"))'="" PSOARBN=PSOIBDAT(350,PSOIBN_",",.11,"E") ;AR BILLING NUMBER
S:$G(PSOIBDAT(350,PSOIBN_",",.13,"E"))'="" PSOINST=PSOIBDAT(350,PSOIBN_",",.13,"I") ;INSTITUTION
;
;save data in XTMP file
S ^XTMP(NAMSP,"DOM",PSORDT,PSODFN,RXP,PSOFILL)=PSOAT_"^"_PSOISTAT_"^"_PSOTAMT_"^"_PSOARBN_"^"_PSOINST
Q
;
CANCEL ;cancel copay
; verify again that it was billed and not already cancelled
S PSOBILLD=0,YY=PSOREF,PSOIB=0
I YY=0,+$P($G(^PSRX(RXP,"IB")),"^",2)>0 D CHKIB^PSOCP1 I $G(PSOIB)=1!($G(PSOIB)=3) S PSOBILLD=1
I YY>0,+$P($G(^PSRX(RXP,1,PSOREF,"IB")),"^")>0 D CHKIB^PSOCP1 I $G(PSOIB)=1!($G(PSOIB)=3) S PSOBILLD=1
Q:'PSOBILLD
;
D NOW^%DTC S PSODT=%,PSODA=RXP,PSOCOMM="- FMCT DOM COPAY CANCEL",PSOOLD="",PSONW="",PREA=""
I PSOREF=0 D CHKACT
S PSOIB="",PSOIB=$S(PSOREF>0:$G(^PSRX(RXP,1,YY,"IB")),'PSOREF:$G(^PSRX(PSODA,"IB")),1:"")
S PSOOIB="",PSOOIB=$G(^PSRX(RXP,"IB"))
D SITE S PSOCOMM="- FMCT DOM COPAY CANCEL"
;PSOCPA requires PSODA,PSO,PSODAYS,PSOFLAG
S PSODA=RXP,PSOFLAG=0,PSO=3,PSODAYS=$$GET1^DIQ(52,RXP,8),PSOOLD="",PSONW="",PREA="C"
D RXED^PSOCPA
K:PSOREF=0 ^PSRX(RXP,"IB") ;...Original Rx
I PSOREF>0 D ACTLOG^PSOCPA K ^PSRX(RXP,1,PSOREF,"IB")
Q
;
SITE ; SET UP VARIABLES NEEDED BY BILLING
S PSOSITE=$S(YY=0:$P(^PSRX(RXP,2),"^",9),1:$P($G(^PSRX(RXP,1,YY,0)),"^",9))
Q:PSOSITE=""
S PSOPAR=$G(^PS(59,PSOSITE,1))
S PSOPAR7=$G(^PS(59,PSOSITE,"IB"))
S PSOSITE7=$P($G(^PS(59,PSOSITE,"IB")),"^")
Q
;
CHKACT ;check activity log for prev entry
N ZACT,ZPSI,ZACTI
S ZPSI=0 F S ZPSI=$O(^PSRX(PSODA,"COPAY",ZPSI)) Q:ZPSI="" S ZACTI="",ZACTI=$G(^PSRX(PSODA,"COPAY",ZPSI,0))
S PSOREF=0,PSOOLD="Copay",PSONW="No Copay",PREA="R" D ACTLOG^PSOCPA S PSOREF=PSOFILL
Q
;
CHKCAN ;verify that cancel copay worked
D CHECK
I PSOIB S ^XTMP(NAMSP,"CANCEL PROBLEM",PSORDT,RXP,PSOFILL)=""
Q
;
REPORT ;accumulate reports information for national and local
;S ^XTMP(NAMSP,"DOM",PSORDT,PSODFN,PSORX,PSOFILL)=PSOAT_"^"_PSOISTAT_"^"_PSOTAMT_"^"_PSOARBN_"^"_PSOINST
K ^TMP($J,"FMCT DOM MSG")
S (XX,JJ,PSORDT,PSODFN,PSORX,PSORXE,PSOTDOL,PSOTRX,PSOTMRX,PSOTPAT,PSOAT,PSOISTAT,PSOTAMT,PSOARBN,PSOINST)=""
S (PSOTPAT,PSOTDOL,PSOTAMT)=0
S ^TMP($J,"FMCT DOM MSG",1)="PSO*7*480 FMCT DOMICILIARY CANCEL COPAY - Detailed Listing"
S ^TMP($J,"FMCT DOM MSG",2)=" RELEASE DATE PATIENT RX # FILL # IB ACTION TYPE TTL AMT AR BILL # INST"
S JJ=2
F S PSORDT=$O(^XTMP(NAMSP,"DOM",PSORDT)) Q:PSORDT="" F S PSODFN=$O(^XTMP(NAMSP,"DOM",PSORDT,PSODFN)) Q:PSODFN="" S PSOTPAT=PSOTPAT+1 D
.F S PSORX=$O(^XTMP(NAMSP,"DOM",PSORDT,PSODFN,PSORX)) Q:PSORX="" S PSOTRX=PSOTRX+1 D
..F S PSOFILL=$O(^XTMP(NAMSP,"DOM",PSORDT,PSODFN,PSORX,PSOFILL)) Q:PSOFILL="" D
...S XX=^XTMP(NAMSP,"DOM",PSORDT,PSODFN,PSORX,PSOFILL)
...S PSOAT=$P(XX,"^"),PSOISTAT=$P(XX,"^",2),PSOTAMT=$P(XX,"^",3),PSOARBN=$P(XX,"^",4),PSOINST=$P(XX,"^",5),PSOFILL1=PSOFILL
...S PSOTDOL=PSOTDOL+PSOTAMT,PSORXE=$P(^PSRX(PSORX,0),"^",1)
...S JJ=JJ+1 S PSONAM=$P(^DPT(PSODFN,0),"^",1),PSONML=$L(PSONAM),$P(PSONAM," ",21-PSONML)=""
...S ^TMP($J,"FMCT DOM MSG",JJ)=$J($$FMTE^XLFDT(PSORDT),21)_" "_PSONAM_" "_$J(PSORXE,15)_" "_$J(PSOFILL1,2)_" "_$J(PSOAT,30)_" "_$J(PSOTAMT_".00",6)_" "_$J(PSOARBN,6)_" "_PSOINST
Q
;
MAIL ;email reports
;
MAIL1 ;management mail message for total patients and dollars
N XMX S PSOINST=$P($G(^DIC(4,+$P($G(^XMB(1,1,"XUS")),"^",17),99)),"^")
D NOW^%DTC S Y=% D DD^%DT S PSOEND=Y
K PSOTEXT
S XMY(DUZ)=DUZ
S XMDUZ="noreply.domain.ext"
S XMY("ELLZEY.LINDA@DOMAIN.EXT")=""
S XMY("CROSSMAN.PAM@DOMAIN.EXT")=""
S XMY("PAMELA.CROSSMAN@DOMAIN.EXT")=""
S XMY("LINDA.ELLZEY@DOMAIN.EXT")=""
S XMY("PAMELA.GUNDERSON@DOMAIN.EXT")=""
S XMY("AMY.VANEPPS@DOMAIN.EXT")=""
S XMY("MITCHELL.FETTERMAN@DOMAIN.EXT")=""
S XMX="PRCA ADJUSTMENT TRANS",XMY("G."_XMX_"@"_^XMB("NETNAME"))=""
S:$$PROD^XUPROD(1) XMY("ELLZEY.LINDA@DOMAIN.EXT")=""
S XMDUZ="noreply.domain.ext"
S XMSUB="STATION "_$G(PSOINST)
S XMSUB=XMSUB_$S($$PROD^XUPROD(1):" (Prod)",1:" (Test)")
S XMSUB=XMSUB_"PSO*7*480 FMCT DOMICILIARY CANCEL COPAY"
S PSOTEXT(1)=""
S PSOTEXT(2)="Post install started "_PSOSTART_" and completed "_PSOEND_"."
S PSOTEXT(3)=""
S PSOTEXT(4)="Summary for Domiciliary Patients with copay cancellations:"
S PSOTEXT(5)=""
S PSOTEXT(6)="Total Number of Prescriptions: "_PSOTRX
S PSOTEXT(7)="Total Number of Prescriptions requiring manual intervention: "_PSOTMRX
S PSOTEXT(9)="Total Number of Patients: "_PSOTPAT
S PSOTEXT(10)="Total Dollars for Cancelled Copays: "_PSOTDOL
S PSOTEXT(11)=""
S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
;
MAIL2 ;site detailed report email
N XMY,XMSUB,XMDUZ,XMTEXT,XMX
S XMDUZ="noreply.domain.ext"
S XMY(DUZ)=DUZ
S XMY("ELLZEY.LINDA@DOMAIN.EXT")=""
S XMY("CROSSMAN.PAM@DOMAIN.EXT")=""
S XMX="PRCA ADJUSTMENT TRANS",XMY("G."_XMX_"@"_^XMB("NETNAME"))=""
S:$$PROD^XUPROD(1) XMY("ELLZEY.LINDA@DOMAIN.EXT")=""
S XMSUB="FMCT DOMICILIARY CANCEL COPAY DETAILED REPORT (PSO*7*480)"
S XMDUZ="noreply.domain.ext"
S XMTEXT="^TMP($J,""FMCT DOM MSG""," N DIFROM D ^XMD
;
MAIL3 ;delimited file
N XMY,XMSUB,XMDUZ,XMTEXT,PSOCNT,PSONAM,XMX
S (PSORDT,PSODFN,RXP,PSOFILL,PSOAT,PSOISTAT,PSOTAMT,PSOARBN,PSOINST,PSOCNT,PSONAM)=""
S XMDUZ="noreply.domain.ext"
S XMY(DUZ)=DUZ
S XMY("ELLZEY.LINDA@DOMAIN.EXT")=""
S XMY("CROSSMAN.PAM@DOMAIN.EXT")=""
S XMX="PRCA ADJUSTMENT TRANS",XMY("G."_XMX_"@"_^XMB("NETNAME"))=""
S ^TMP($J,"FMCT DOM DLMT",1)="PSO*7*480 FMCT DOMICILIARY CANCEL COPAY - Delimited File"
S ^TMP($J,"FMCT DOM DLMT",2)=""
S ^TMP($J,"FMCT DOM DLMT",3)="Post install started "_PSOSTART_" and completed "_PSOEND_"."
S ^TMP($J,"FMCT DOM DLMT",4)=""
S ^TMP($J,"FMCT DOM DLMT",5)="RELEASE DATE^PATIENT NAME^PRESCRIPTION#^FILL NUMBER^IB ACTION TYPE^TOTAL AMOUNT^AR BILL #^INST"
S PSOCNT=5
MAILL ;
;
F S PSORDT=$O(^XTMP(NAMSP,"DOM",PSORDT)) Q:PSORDT="" F S PSODFN=$O(^XTMP(NAMSP,"DOM",PSORDT,PSODFN)) Q:PSODFN="" D
.F S RXP=$O(^XTMP(NAMSP,"DOM",PSORDT,PSODFN,RXP)) Q:RXP="" F S PSOFILL=$O(^XTMP(NAMSP,"DOM",PSORDT,PSODFN,RXP,PSOFILL)) Q:PSOFILL="" S XX="" D
..S (PSONAM,XX)="",XX=^XTMP(NAMSP,"DOM",PSORDT,PSODFN,RXP,PSOFILL)
..S PSOAT=$P(XX,"^"),PSOISTAT=$P(XX,"^",2),PSOTAMT=$P(XX,"^",3),PSOARBN=$P(XX,"^",4),PSOINST=$P(XX,"^",5)
..S PSOCNT=PSOCNT+1,PSONAM=$$GET1^DIQ(2,PSODFN,.01)
..S ^TMP($J,"FMCT DOM DLMT",PSOCNT)=$$FMTE^XLFDT(PSORDT)_"^"_PSONAM_"^"_$$GET1^DIQ(52,RXP,.01)_"^"_PSOFILL_"^"_PSOAT_"^"_PSOTAMT_"^"_PSOARBN_"^"_PSOINST
;
S:$$PROD^XUPROD(1) XMY("ELLZEY.LINDA@DOMAIN.EXT")=""
S XMSUB="FMCT DOMICILIARY CANCEL COPAY DELIMITED FILE (PSO*7*480)"
S XMDUZ="noreply.domain.ext"
S XMTEXT="^TMP($J,""FMCT DOM DLMT""," N DIFROM D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO480P 12369 printed Sep 23, 2025@19:59:09 Page 2
PSO480P ;BIR/PC-Automatic Cancel of Copay charges for DOM ;03/02/17 10:30am
+1 ;;7.0;OUTPATIENT PHARMACY;**480**;DEC 1997;Build 35
+2 ;
+3 ;Reference to ^IB(350 supported by DBIA 2215
+4 ;
+5 ;This routine will run as a post-install for patch PSO*7*480
+6 ;and will loop through the prescription file by release date/time
+7 ;to find all prescriptions for patients logged in as inpatient
+8 ;assigned to a DOMICILIARY ward at release date of prescription.
+9 ;It will then cancel any copay that was charged by mistake with patch PSO*7*460 (FMCT)
+10 ; Both original and refills charges will be cancelled if needed.
+11 ;
+12 ;Detailed and summary reports will be sent to mailman at site.
+13 QUIT
+14 ;
+15 ;going to need an entry point for when the routine is jobbed off during install
EN ;
+1 NEW NAMSP,DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,QUIT,RUNOPT,JOBN,Y,YY,ZTSAVE,VAINDT,VAIN,TITLE,LIFE,BEGDT
+2 SET NAMSP=""
SET NAMSP=$TEXT(+0)
+3 SET LIFE=90
SET TITLE="FMCT Cancel DOMICILIARY Prescription Copay Charges - PSO*7*480"
+4 SET BEGDT=$$NOW^XLFDT()
SET PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
+5 SET ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_TITLE
+6 SET JOBN="FMCT DOMICILIARY CANCEL COPAYS"
+7 LOCK +^XTMP(NAMSP):0
IF '$TEST
Begin DoDot:1
+8 DO BMES^XPDUTL(JOBN_" job is already running. Halting...")
+9 DO MES^XPDUTL("")
+10 DO QUIT
End DoDot:1
QUIT
+11 ;
START ;
+1 ;initialize ^XTMP file according to SAC standard
+2 ;
+3 SET QUIT=0
+4 ;
+5 IF $GET(^XTMP(NAMSP,0,"LAST"))["COMPLETED"
Begin DoDot:1
+6 WRITE !!,*7,"This job previously ran to completion on "
+7 WRITE $$FMTE^XLFDT($PIECE($GET(^XTMP(NAMSP,0,"LAST")),"^",2)),!!
+8 DO QUIT
End DoDot:1
QUIT
+9 ;
+10 ;ques 2, if running from mumps prompt
+11 SET Y=$$NOW^XLFDT
SET ZTDTH=$$FMTH^XLFDT(Y)
+12 ;
+13 ;ques 2, if running from kids install
+14 IF $DATA(XPDQUES("POS2"))
SET ZTDTH=$$FMTH^XLFDT(XPDQUES("POS2"))
+15 ;
+16 DO BMES^XPDUTL("===================================================")
+17 DO MES^XPDUTL("Queuing background job to "_JOBN_"...")
+18 DO MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
+19 DO MES^XPDUTL("===================================================")
+20 IF $DATA(XPDQUES("POS2"))
IF ZTDTH=""
DO BMES^XPDUTL(JOBN_" NOT QUEUED")
DO QUIT
QUIT
+21 ;
+22 if $DATA(^XTMP(NAMSP,0,"LAST"))
SET ^XTMP(NAMSP,0,"ZAUDIT",$HOROLOG)="RE-STARTED ON"_"^"_$$NOW^XLFDT_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
+23 ;
+24 SET ZTRTN="START1^PSO480P"
SET ZTIO=""
+25 SET ZTDESC="Background job for "_JOBN_"."
+26 SET ZTSAVE("JOBN")=""
SET ZTSAVE("NAMSP")=""
+27 LOCK -^XTMP(NAMSP)
+28 DO ^%ZTLOAD
+29 if $DATA(ZTSK)
Begin DoDot:1
+30 DO MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
+31 DO BMES^XPDUTL("")
End DoDot:1
+32 DO BMES^XPDUTL("")
+33 KILL XPDQUES
+34 QUIT
+35 ;
QUIT ;
+1 LOCK -^XTMP(NAMSP)
+2 KILL %,ZTSAVE,VAIN,PSO,PREA,PSOARBN,PSOAT,PSOBILLD,PSOCOMM,PSODA,PSODAYS,PSODT,PSOFILL1,PSOFLAG,PSOIBDAT,PSOINSTL,PSOISTAT,PSONML,PSONW,PSOOIB,PSOOLD,PSOIBN
+3 KILL PSOINST,PSOPAR,PSOPAR7,PSORX,PSOSITE,PSOSITE7,PSOSTAT,PSOTAMT,PSOREF
+4 QUIT
+5 ;
START1 ;
+1 ;initialize ^XTMP file according to SAC standard
+2 NEW BEGDT,PURGDT,LIFE,NAMSP,PSOIB,CHKCAN,PSOSTART,PSOEND,PSOTDOL,PSOTRX,PSOTMRX,PSOTPAT,RXP,X,XX,JJ,PSORXE,PSOFILL,PSOFILL1,PSOREF
+3 SET NAMSP=""
SET NAMSP=$TEXT(+0)
+4 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PSOSTART=Y
+5 SET LIFE=90
SET TITLE="FMCT Cancel DOMICILIARY Prescription Copay Charges - PSO*7*480"
+6 SET BEGDT=$$NOW^XLFDT()
SET PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
SET NAMSP=$TEXT(+0)
+7 KILL ^XTMP(NAMSP)
SET ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_TITLE
+8 ;
INST ;get first install date for FMCT patch PSO*7*460 which will be the begin date for checking for DOMICILIARY copay charges
+1 NEW DATA,PSOINSTD,PSORDT,PSOEDT,PSODOM,PSODFN,DFN,PSODATA,POSIB,PSOIBN
+2 SET (X,XX,DATA)=""
SET X=$$INSTALDT^XPDUTL("PSO*7.0*460",.DATA)
+3 SET PSOINSTD=""
SET PSOINSTD=$ORDER(DATA(PSOINSTD))
+4 ;
LOOP ;loop through AL cross reference
+1 if '$DATA(NAMSP)
SET NAMSP=$TEXT(+0)
+2 SET PSORDT=PSOINSTD\1-.00001
SET (RXP,PSOFILL)=""
+3 FOR
SET PSORDT=$ORDER(^PSRX("AL",PSORDT))
if PSORDT=""
QUIT
FOR
SET RXP=$ORDER(^PSRX("AL",PSORDT,RXP))
if RXP=""
QUIT
Begin DoDot:1
+4 FOR
SET PSOFILL=$ORDER(^PSRX("AL",PSORDT,RXP,PSOFILL))
if PSOFILL=""
QUIT
Begin DoDot:2
+5 SET (PSODFN,DFN,PSODA)=$$GET1^DIQ(52,RXP,2,"I")
SET VAINDT=PSORDT
+6 SET PSODOM=0
DO INP^VADPT
+7 IF $DATA(VAIN(4))
IF $DATA(^DIC(42,+VAIN(4),0))
IF $PIECE(^(0),"^",3)="D"
SET PSODOM=1
+8 ;not a DOMICILIARY
if 'PSODOM
QUIT
+9 SET PSOREF=PSOFILL
+10 ;check if Rx is billed
SET PSOIB=0
DO CHECK
+11 ;if PSOIB=1 Rx is billed
if 'PSOIB
QUIT
+12 KILL PSODATA
+13 IF PSOFILL=0
DO ZERO
+14 IF PSOFILL>0
DO REFILL
+15 ;retrieve IB Action file info and store in XTMP
DO GETIB
+16 ;cancel copay
DO CANCEL
+17 ;verify that cancel copay worked
DO CHKCAN
End DoDot:2
End DoDot:1
+18 DO REPORT
+19 DO MAIL
+20 QUIT
+21 ;
CHECK ;check IB nodes
+1 ; see if bill already exists - returned value of PSOIB1 means Rx is billed
+2 IF PSOFILL=0
IF +$PIECE($GET(^PSRX(RXP,"IB")),"^",2)>0
DO CHKIB^PSOCP1
+3 IF PSOFILL>0
IF +$GET(^PSRX(RXP,1,PSOFILL,"IB"))
DO CHKIB^PSOCP1
+4 QUIT
+5 ;
ZERO ;
+1 ;get prescription information
+2 DO GETS^DIQ(52,RXP_",","3;31;106","I","PSODATA")
+3 if $GET(PSODATA(52,RXP_",",3,"I"))
SET PSOSTAT=PSODATA(52,RXP_",",3,"I")
+4 if $GET(PSODATA(52,RXP_",",106,"I"))
SET PSOIBN=PSODATA(52,RXP_",",106,"I")
+5 QUIT
+6 ;
REFILL ;
+1 DO GETS^DIQ(52.1,PSOFILL_","_RXP_",",".01;3;9","I","PSODATA")
+2 if $GET(PSODATA(52.1,PSOFILL_","_RXP_",",3,"I"))
SET (DFN,PSODFN)=PSODATA(52.1,PSOFILL_","_RXP_",",3,"I")
+3 if $GET(PSODATA(52.1,PSOFILL_","_RXP_",",9,"I"))
SET PSOIBN=PSODATA(52.1,PSOFILL_","_RXP_",",9,"I")
+4 QUIT
+5 ;
GETIB ;get billing information from IB Billing Action file #350
+1 DO GETS^DIQ(350,PSOIBN,".03;.05;.07;.11;.13","IE","PSOIBDAT")
+2 SET (PSOAT,PSOISTAT,PSOTAMT,PSOARBN,PSOINST)=""
+3 ;ACTION TYPE
if $GET(PSOIBDAT(350,PSOIBN_",",.03,"E"))'=""
SET PSOAT=PSOIBDAT(350,PSOIBN_",",.03,"E")
+4 ;STATUS
if $GET(PSOIBDAT(350,PSOIBN_",",.05,"E"))'=""
SET PSOISTAT=PSOIBDAT(350,PSOIBN_",",.05,"E")
+5 ;TOTAL CHARGE
if $GET(PSOIBDAT(350,PSOIBN_",",.07,"E"))'=""
SET PSOTAMT=PSOIBDAT(350,PSOIBN_",",.07,"E")
+6 ;AR BILLING NUMBER
if $GET(PSOIBDAT(350,PSOIBN_",",.11,"E"))'=""
SET PSOARBN=PSOIBDAT(350,PSOIBN_",",.11,"E")
+7 ;INSTITUTION
if $GET(PSOIBDAT(350,PSOIBN_",",.13,"E"))'=""
SET PSOINST=PSOIBDAT(350,PSOIBN_",",.13,"I")
+8 ;
+9 ;save data in XTMP file
+10 SET ^XTMP(NAMSP,"DOM",PSORDT,PSODFN,RXP,PSOFILL)=PSOAT_"^"_PSOISTAT_"^"_PSOTAMT_"^"_PSOARBN_"^"_PSOINST
+11 QUIT
+12 ;
CANCEL ;cancel copay
+1 ; verify again that it was billed and not already cancelled
+2 SET PSOBILLD=0
SET YY=PSOREF
SET PSOIB=0
+3 IF YY=0
IF +$PIECE($GET(^PSRX(RXP,"IB")),"^",2)>0
DO CHKIB^PSOCP1
IF $GET(PSOIB)=1!($GET(PSOIB)=3)
SET PSOBILLD=1
+4 IF YY>0
IF +$PIECE($GET(^PSRX(RXP,1,PSOREF,"IB")),"^")>0
DO CHKIB^PSOCP1
IF $GET(PSOIB)=1!($GET(PSOIB)=3)
SET PSOBILLD=1
+5 if 'PSOBILLD
QUIT
+6 ;
+7 DO NOW^%DTC
SET PSODT=%
SET PSODA=RXP
SET PSOCOMM="- FMCT DOM COPAY CANCEL"
SET PSOOLD=""
SET PSONW=""
SET PREA=""
+8 IF PSOREF=0
DO CHKACT
+9 SET PSOIB=""
SET PSOIB=$SELECT(PSOREF>0:$GET(^PSRX(RXP,1,YY,"IB")),'PSOREF:$GET(^PSRX(PSODA,"IB")),1:"")
+10 SET PSOOIB=""
SET PSOOIB=$GET(^PSRX(RXP,"IB"))
+11 DO SITE
SET PSOCOMM="- FMCT DOM COPAY CANCEL"
+12 ;PSOCPA requires PSODA,PSO,PSODAYS,PSOFLAG
+13 SET PSODA=RXP
SET PSOFLAG=0
SET PSO=3
SET PSODAYS=$$GET1^DIQ(52,RXP,8)
SET PSOOLD=""
SET PSONW=""
SET PREA="C"
+14 DO RXED^PSOCPA
+15 ;...Original Rx
if PSOREF=0
KILL ^PSRX(RXP,"IB")
+16 IF PSOREF>0
DO ACTLOG^PSOCPA
KILL ^PSRX(RXP,1,PSOREF,"IB")
+17 QUIT
+18 ;
SITE ; SET UP VARIABLES NEEDED BY BILLING
+1 SET PSOSITE=$SELECT(YY=0:$PIECE(^PSRX(RXP,2),"^",9),1:$PIECE($GET(^PSRX(RXP,1,YY,0)),"^",9))
+2 if PSOSITE=""
QUIT
+3 SET PSOPAR=$GET(^PS(59,PSOSITE,1))
+4 SET PSOPAR7=$GET(^PS(59,PSOSITE,"IB"))
+5 SET PSOSITE7=$PIECE($GET(^PS(59,PSOSITE,"IB")),"^")
+6 QUIT
+7 ;
CHKACT ;check activity log for prev entry
+1 NEW ZACT,ZPSI,ZACTI
+2 SET ZPSI=0
FOR
SET ZPSI=$ORDER(^PSRX(PSODA,"COPAY",ZPSI))
if ZPSI=""
QUIT
SET ZACTI=""
SET ZACTI=$GET(^PSRX(PSODA,"COPAY",ZPSI,0))
+3 SET PSOREF=0
SET PSOOLD="Copay"
SET PSONW="No Copay"
SET PREA="R"
DO ACTLOG^PSOCPA
SET PSOREF=PSOFILL
+4 QUIT
+5 ;
CHKCAN ;verify that cancel copay worked
+1 DO CHECK
+2 IF PSOIB
SET ^XTMP(NAMSP,"CANCEL PROBLEM",PSORDT,RXP,PSOFILL)=""
+3 QUIT
+4 ;
REPORT ;accumulate reports information for national and local
+1 ;S ^XTMP(NAMSP,"DOM",PSORDT,PSODFN,PSORX,PSOFILL)=PSOAT_"^"_PSOISTAT_"^"_PSOTAMT_"^"_PSOARBN_"^"_PSOINST
+2 KILL ^TMP($JOB,"FMCT DOM MSG")
+3 SET (XX,JJ,PSORDT,PSODFN,PSORX,PSORXE,PSOTDOL,PSOTRX,PSOTMRX,PSOTPAT,PSOAT,PSOISTAT,PSOTAMT,PSOARBN,PSOINST)=""
+4 SET (PSOTPAT,PSOTDOL,PSOTAMT)=0
+5 SET ^TMP($JOB,"FMCT DOM MSG",1)="PSO*7*480 FMCT DOMICILIARY CANCEL COPAY - Detailed Listing"
+6 SET ^TMP($JOB,"FMCT DOM MSG",2)=" RELEASE DATE PATIENT RX # FILL # IB ACTION TYPE TTL AMT AR BILL # INST"
+7 SET JJ=2
+8 FOR
SET PSORDT=$ORDER(^XTMP(NAMSP,"DOM",PSORDT))
if PSORDT=""
QUIT
FOR
SET PSODFN=$ORDER(^XTMP(NAMSP,"DOM",PSORDT,PSODFN))
if PSODFN=""
QUIT
SET PSOTPAT=PSOTPAT+1
Begin DoDot:1
+9 FOR
SET PSORX=$ORDER(^XTMP(NAMSP,"DOM",PSORDT,PSODFN,PSORX))
if PSORX=""
QUIT
SET PSOTRX=PSOTRX+1
Begin DoDot:2
+10 FOR
SET PSOFILL=$ORDER(^XTMP(NAMSP,"DOM",PSORDT,PSODFN,PSORX,PSOFILL))
if PSOFILL=""
QUIT
Begin DoDot:3
+11 SET XX=^XTMP(NAMSP,"DOM",PSORDT,PSODFN,PSORX,PSOFILL)
+12 SET PSOAT=$PIECE(XX,"^")
SET PSOISTAT=$PIECE(XX,"^",2)
SET PSOTAMT=$PIECE(XX,"^",3)
SET PSOARBN=$PIECE(XX,"^",4)
SET PSOINST=$PIECE(XX,"^",5)
SET PSOFILL1=PSOFILL
+13 SET PSOTDOL=PSOTDOL+PSOTAMT
SET PSORXE=$PIECE(^PSRX(PSORX,0),"^",1)
+14 SET JJ=JJ+1
SET PSONAM=$PIECE(^DPT(PSODFN,0),"^",1)
SET PSONML=$LENGTH(PSONAM)
SET $PIECE(PSONAM," ",21-PSONML)=""
+15 SET ^TMP($JOB,"FMCT DOM MSG",JJ)=$JUSTIFY($$FMTE^XLFDT(PSORDT),21)_" "_PSONAM_" "_$JUSTIFY(PSORXE,15)_" "_$JUSTIFY(PSOFILL1,2)_" "_$JUSTIFY(PSOAT,30)_" "_$JUSTIFY(PSOTAMT_".00",6)_" "_$JUSTIFY(PSOARBN,6)_"
"_PSOINST
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
MAIL ;email reports
+1 ;
MAIL1 ;management mail message for total patients and dollars
+1 NEW XMX
SET PSOINST=$PIECE($GET(^DIC(4,+$PIECE($GET(^XMB(1,1,"XUS")),"^",17),99)),"^")
+2 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PSOEND=Y
+3 KILL PSOTEXT
+4 SET XMY(DUZ)=DUZ
+5 SET XMDUZ="noreply.domain.ext"
+6 SET XMY("ELLZEY.LINDA@DOMAIN.EXT")=""
+7 SET XMY("CROSSMAN.PAM@DOMAIN.EXT")=""
+8 SET XMY("PAMELA.CROSSMAN@DOMAIN.EXT")=""
+9 SET XMY("LINDA.ELLZEY@DOMAIN.EXT")=""
+10 SET XMY("PAMELA.GUNDERSON@DOMAIN.EXT")=""
+11 SET XMY("AMY.VANEPPS@DOMAIN.EXT")=""
+12 SET XMY("MITCHELL.FETTERMAN@DOMAIN.EXT")=""
+13 SET XMX="PRCA ADJUSTMENT TRANS"
SET XMY("G."_XMX_"@"_^XMB("NETNAME"))=""
+14 if $$PROD^XUPROD(1)
SET XMY("ELLZEY.LINDA@DOMAIN.EXT")=""
+15 SET XMDUZ="noreply.domain.ext"
+16 SET XMSUB="STATION "_$GET(PSOINST)
+17 SET XMSUB=XMSUB_$SELECT($$PROD^XUPROD(1):" (Prod)",1:" (Test)")
+18 SET XMSUB=XMSUB_"PSO*7*480 FMCT DOMICILIARY CANCEL COPAY"
+19 SET PSOTEXT(1)=""
+20 SET PSOTEXT(2)="Post install started "_PSOSTART_" and completed "_PSOEND_"."
+21 SET PSOTEXT(3)=""
+22 SET PSOTEXT(4)="Summary for Domiciliary Patients with copay cancellations:"
+23 SET PSOTEXT(5)=""
+24 SET PSOTEXT(6)="Total Number of Prescriptions: "_PSOTRX
+25 SET PSOTEXT(7)="Total Number of Prescriptions requiring manual intervention: "_PSOTMRX
+26 SET PSOTEXT(9)="Total Number of Patients: "_PSOTPAT
+27 SET PSOTEXT(10)="Total Dollars for Cancelled Copays: "_PSOTDOL
+28 SET PSOTEXT(11)=""
+29 SET XMTEXT="PSOTEXT("
NEW DIFROM
DO ^XMD
KILL XMDUZ,XMTEXT,XMSUB
+30 ;
MAIL2 ;site detailed report email
+1 NEW XMY,XMSUB,XMDUZ,XMTEXT,XMX
+2 SET XMDUZ="noreply.domain.ext"
+3 SET XMY(DUZ)=DUZ
+4 SET XMY("ELLZEY.LINDA@DOMAIN.EXT")=""
+5 SET XMY("CROSSMAN.PAM@DOMAIN.EXT")=""
+6 SET XMX="PRCA ADJUSTMENT TRANS"
SET XMY("G."_XMX_"@"_^XMB("NETNAME"))=""
+7 if $$PROD^XUPROD(1)
SET XMY("ELLZEY.LINDA@DOMAIN.EXT")=""
+8 SET XMSUB="FMCT DOMICILIARY CANCEL COPAY DETAILED REPORT (PSO*7*480)"
+9 SET XMDUZ="noreply.domain.ext"
+10 SET XMTEXT="^TMP($J,""FMCT DOM MSG"","
NEW DIFROM
DO ^XMD
+11 ;
MAIL3 ;delimited file
+1 NEW XMY,XMSUB,XMDUZ,XMTEXT,PSOCNT,PSONAM,XMX
+2 SET (PSORDT,PSODFN,RXP,PSOFILL,PSOAT,PSOISTAT,PSOTAMT,PSOARBN,PSOINST,PSOCNT,PSONAM)=""
+3 SET XMDUZ="noreply.domain.ext"
+4 SET XMY(DUZ)=DUZ
+5 SET XMY("ELLZEY.LINDA@DOMAIN.EXT")=""
+6 SET XMY("CROSSMAN.PAM@DOMAIN.EXT")=""
+7 SET XMX="PRCA ADJUSTMENT TRANS"
SET XMY("G."_XMX_"@"_^XMB("NETNAME"))=""
+8 SET ^TMP($JOB,"FMCT DOM DLMT",1)="PSO*7*480 FMCT DOMICILIARY CANCEL COPAY - Delimited File"
+9 SET ^TMP($JOB,"FMCT DOM DLMT",2)=""
+10 SET ^TMP($JOB,"FMCT DOM DLMT",3)="Post install started "_PSOSTART_" and completed "_PSOEND_"."
+11 SET ^TMP($JOB,"FMCT DOM DLMT",4)=""
+12 SET ^TMP($JOB,"FMCT DOM DLMT",5)="RELEASE DATE^PATIENT NAME^PRESCRIPTION#^FILL NUMBER^IB ACTION TYPE^TOTAL AMOUNT^AR BILL #^INST"
+13 SET PSOCNT=5
MAILL ;
+1 ;
+2 FOR
SET PSORDT=$ORDER(^XTMP(NAMSP,"DOM",PSORDT))
if PSORDT=""
QUIT
FOR
SET PSODFN=$ORDER(^XTMP(NAMSP,"DOM",PSORDT,PSODFN))
if PSODFN=""
QUIT
Begin DoDot:1
+3 FOR
SET RXP=$ORDER(^XTMP(NAMSP,"DOM",PSORDT,PSODFN,RXP))
if RXP=""
QUIT
FOR
SET PSOFILL=$ORDER(^XTMP(NAMSP,"DOM",PSORDT,PSODFN,RXP,PSOFILL))
if PSOFILL=""
QUIT
SET XX=""
Begin DoDot:2
+4 SET (PSONAM,XX)=""
SET XX=^XTMP(NAMSP,"DOM",PSORDT,PSODFN,RXP,PSOFILL)
+5 SET PSOAT=$PIECE(XX,"^")
SET PSOISTAT=$PIECE(XX,"^",2)
SET PSOTAMT=$PIECE(XX,"^",3)
SET PSOARBN=$PIECE(XX,"^",4)
SET PSOINST=$PIECE(XX,"^",5)
+6 SET PSOCNT=PSOCNT+1
SET PSONAM=$$GET1^DIQ(2,PSODFN,.01)
+7 SET ^TMP($JOB,"FMCT DOM DLMT",PSOCNT)=$$FMTE^XLFDT(PSORDT)_"^"_PSONAM_"^"_$$GET1^DIQ(52,RXP,.01)_"^"_PSOFILL_"^"_PSOAT_"^"_PSOTAMT_"^"_PSOARBN_"^"_PSOINST
End DoDot:2
End DoDot:1
+8 ;
+9 if $$PROD^XUPROD(1)
SET XMY("ELLZEY.LINDA@DOMAIN.EXT")=""
+10 SET XMSUB="FMCT DOMICILIARY CANCEL COPAY DELIMITED FILE (PSO*7*480)"
+11 SET XMDUZ="noreply.domain.ext"
+12 SET XMTEXT="^TMP($J,""FMCT DOM DLMT"","
NEW DIFROM
DO ^XMD
+13 QUIT
