| 1 | PSOFIXDT ;BHAM ISC/RTR - COSIGNER AND FILL DATE CLEAN UP;7/29/94
|
|---|
| 2 | ;;6.0;OUTPATIENT PHARMACY;**124**;APRIL 1993
|
|---|
| 3 | S PSOSTART=$O(^PS(59.7,0)) I +$P(^PS(59.7,PSOSTART,49.99),"^")<6 W !,"It appears from your version entry in your Pharmacy System File (#59.7)",!,"that you are not running Outpatient V 6.0.!",! G END
|
|---|
| 4 | S PSOSTART=$O(^PS(59.7,0)),PSOSTART=$P($G(^PS(59.7,PSOSTART,49.99)),"^",2) I 'PSOSTART W !,"There is a problem with the Date OP Installed field in your Pharmacy",!,"System File (#59.7), check entry and start again!",!! G END
|
|---|
| 5 | W @IOF W !,"This routine will queue three separate jobs.",!
|
|---|
| 6 | W !,"One job will generate a mail message listing prescriptions with missing",!,"Fill dates or Refill dates.",!
|
|---|
| 7 | W !,"A second job will generate a mail message listing entries in your Suspense",!,"File (#52.5) with missing Suspense dates.",!
|
|---|
| 8 | W !,"A third job will look through your prescription file for any -1 entries",!,"in your Cosigning Physician field.",!
|
|---|
| 9 | W "If we find any, we will update that field with the appropriate entry,",!,"based on the Usual Cosigner field in the New Person File for the",!,"provider of the prescription. If there is a problem with the Usual Cosigner"
|
|---|
| 10 | W !,"entry in the New Person File, we will set that field to null.",!,"A mail message will be sent to you with the number of entries changed.",!
|
|---|
| 11 | S X1=PSOSTART,X2=-1 D C^%DTC S PSOSTART=X
|
|---|
| 12 | D NOW^%DTC S %DT="RAEX",%DT(0)=%,%DT("B")="NOW",%DT("A")="QUEUE JOBS TO RUN AT WHAT TIME: " D ^%DT S PSOQTIME=Y I $D(DTOUT)!(Y=-1) W !,"Try again later!",! G END
|
|---|
| 13 | S ZTIO="",ZTRTN="BEG^PSOFIXDT",ZTDTH=PSOQTIME,ZTDESC="CHECK BAD PROVIDER ENTRIES",ZTSAVE("PSOSTART")=PSOSTART D ^%ZTLOAD
|
|---|
| 14 | S ZTIO="",ZTRTN="SUS^PSOFIXDT",ZTDTH=PSOQTIME,ZTDESC="CHECK FOR MISSING SUSPENSE DATES" D ^%ZTLOAD
|
|---|
| 15 | S ZTIO="",ZTRTN="START^PSOFIXDT",ZTDTH=PSOQTIME,ZTDESC="CHECK FOR MISSING FILL DATES",ZTSAVE("PSOSTART")=PSOSTART D ^%ZTLOAD W !!,"TASKS QUEUED!",! G END
|
|---|
| 16 | BEG K ^TMP($J,"TRANS") S ^TMP($J,"TRANS",1,0)="Following are counts for the -1 entries found in the Prescription File (#52).",^TMP($J,"TRANS",2,0)=" ",^TMP($J,"TRANS",3,0)=" "
|
|---|
| 17 | S (PSOTOT,CNT,PSOCNT)=0 F AAA=PSOSTART:0 S AAA=$O(^PSRX("AD",AAA)) Q:'AAA F BBB=0:0 S BBB=$O(^PSRX("AD",AAA,BBB)) Q:'BBB I $P($G(^PSRX(BBB,3)),"^",3)=-1 K DA,DR,PSUS,PSPRV S PSCOS=0,PSPRV=+$P($G(^PSRX(BBB,0)),"^",4) D
|
|---|
| 18 | .I PSPRV,+$P($G(^VA(200,PSPRV,"PS")),"^",7),+$P($G(^("PS")),"^",8) S PSCNUM=$P(^("PS"),"^",8) I $D(^VA(200,PSCNUM,"PS")),$P(^("PS"),"^"),'$P(^("PS"),"^",7),$S('$P(^("PS"),"^",4):1,1:$P(^("PS"),"^",4)'<DT) S PSCOS=1
|
|---|
| 19 | .I PSCOS S DIE="^PSRX(",DA=BBB,DR="109////"_PSCNUM D ^DIE S CNT=CNT+1 Q
|
|---|
| 20 | .I 'PSCOS S DIE="^PSRX(",DA=BBB,DR="109////"_"@" D ^DIE S PSOCNT=PSOCNT+1 Q
|
|---|
| 21 | S PSOTOT=CNT+PSOCNT,^TMP($J,"TRANS",4,0)="Number of -1 entries changed to a provider based on the Usual Provider entry in the New Person File (#200): "_$G(CNT)
|
|---|
| 22 | S ^TMP($J,"TRANS",5,0)=" ",^TMP($J,"TRANS",6,0)="Number of -1 entries changed to null: "_$G(PSOCNT),^TMP($J,"TRANS",7,0)=" ",^TMP($J,"TRANS",8,0)="Total entries changed: "_$G(PSOTOT)
|
|---|
| 23 | S XMSUB="Invalid -1 entries for Cosigning Physician" D MAIL G END
|
|---|
| 24 | START K ^TMP($J,"TRANS") S ^TMP($J,"TRANS",1,0)="Following are Rx fills that are missing either a Fill Date or a Refill Date:",^TMP($J,"TRANS",2,0)=" "
|
|---|
| 25 | F CCC=1:1 S X1=PSOSTART,X2=CCC D C^%DTC I $O(^PSRX("AD",X,0)) S RXSTART=$O(^PSRX("AD",X,0)) Q
|
|---|
| 26 | S PSOCOUNT=0,PSSUB=3 F PPP=RXSTART:0 S PPP=$O(^PSRX(PPP)) Q:'PPP D
|
|---|
| 27 | .Q:$P($G(^PSRX(PPP,0)),"^",15)=3
|
|---|
| 28 | .S RXNUM=$P($G(^PSRX(PPP,0)),"^")
|
|---|
| 29 | .I $D(^PSRX(PPP,2)),'$P($G(^(2)),"^",2) S ^TMP($J,"TRANS",PSSUB,0)="Rx number: "_$G(RXNUM)_" Original fill" S PSSUB=PSSUB+1,PSOCOUNT=PSOCOUNT+1
|
|---|
| 30 | .F LLL=0:0 S LLL=$O(^PSRX(PPP,1,LLL)) Q:'LLL I $D(^PSRX(PPP,1,LLL,0)),'$P($G(^(0)),"^") S ^TMP($J,"TRANS",PSSUB,0)="Rx number: "_$G(RXNUM)_" Refill number: "_$G(LLL) S PSSUB=PSSUB+1,PSOCOUNT=PSOCOUNT+1
|
|---|
| 31 | I 'PSOCOUNT S ^TMP($J,"TRANS",3,0)="NO MISSING FILL DATES WERE FOUND!"
|
|---|
| 32 | S XMSUB="Missing Fill Dates" D MAIL G END
|
|---|
| 33 | SUS S SUSCOUNT=4 K ^TMP($J,"TRANS") S ^TMP($J,"TRANS",1,0)="Following are entries in your suspense file (#52.5) that are missing a suspense date."
|
|---|
| 34 | S ^TMP($J,"TRANS",2,0)="The Internal Rx Number is the .01 field in the Suspense File (#52.5).",^TMP($J,"TRANS",3,0)=" "
|
|---|
| 35 | F RRR=0:0 S RRR=$O(^PS(52.5,RRR)) Q:'RRR I '$P($G(^PS(52.5,RRR,0)),"^",2) S ^TMP($J,"TRANS",SUSCOUNT,0)="Rx Number: "_$P($G(^PSRX($P($G(^PS(52.5,RRR,0)),"^"),0)),"^")_" Internal Rx number: "_$P($G(^PS(52.5,RRR,0)),"^") S SUSCOUNT=SUSCOUNT+1
|
|---|
| 36 | I SUSCOUNT=4 S ^TMP($J,"TRANS",5,0)="NO MISSING SUSPENSE DATES FOUND!"
|
|---|
| 37 | S XMSUB="Missing suspense dates" D MAIL
|
|---|
| 38 | END K ^TMP($J),XMDUZ,PSPRV,CNT,PSCOS,PSCNUM,PSOCNT,PSOTOT,PSOQTIME,PSOSTART,AAA,BBB,%DT,Y,DIE,DA,DR,PSSUB,PSOCOUNT,CCC,PPP,RRR,SUSCOUNT,RXNUM,DTOUT,DUOUT,XMDUZ,XMSUB,XMY,XMTEXT,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE S:$D(ZTQUEUED) ZTREQ="@" Q
|
|---|
| 39 | MAIL S XMDUZ=.5,XMY(DUZ)="",XMY(DUZ,1)="I",XMTEXT="^TMP($J,""TRANS""," D ^XMD Q
|
|---|
