| [613] | 1 | PSOTPCEE ;BIR/MHA-transitional pharmacy benefit enter/edit ;07/01/03
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**145,153,227,268**;DEC 1997;Build 9
|
|---|
| 3 | ;;External reference to SDPHARM1 supported by DBIA 4196
|
|---|
| 4 | ;;External reference ^DIC(4 supported by DBIA 2251
|
|---|
| 5 | Q ;placed out of order by PSO87*227
|
|---|
| 6 | ST N PSODFN,FLG,PSODF,FI,INST,SNO,CDT,UL S FI=52.91,$P(UL,"=",79)="="
|
|---|
| 7 | PT K DIC,DIE,PSODFN,FLG,PSODF,REC,INST,SNO,CDT
|
|---|
| 8 | W ! S (DIC,DIE)=52.91,DIC(0)="QEALM",DLAYGO=FI
|
|---|
| 9 | ;S DIC("W")="W ?15,$$GET1^DIQ(2,+Y,.01)"
|
|---|
| 10 | D ^DIC G:+Y'>0 PTX S FLG=$P(Y,"^",3)
|
|---|
| 11 | S (PSODFN,DA)=+Y,DR=.351,DIC=2,DIQ="PSODF" D EN^DIQ1 K DIC,DR,DIQ
|
|---|
| 12 | I $G(PSODF(2,DA,.351))]"",FLG D G PT
|
|---|
| 13 | .W !!?10,$C(7),"Patient died on "_PSODF(2,PSODFN,.351)_" - Cannot be added to file!!",!
|
|---|
| 14 | .S DIK="^PS(52.91," D ^DIK K DIK
|
|---|
| 15 | L +^PS(FI,DA):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T W $C(7),!!,"Patient Data is Being Edited by Another User!",! G PT
|
|---|
| 16 | S (INST,SNO)="" D:FLG
|
|---|
| 17 | .S X=$$DEF^SDPHARM1(DA) S:X INST=$P(X,"^"),SNO=$P(X,"^",2)
|
|---|
| 18 | .S DR="1////"_DT_";5////M;6////"_SNO_";7////"_INST D ^DIE
|
|---|
| 19 | INS S REC=$G(^PS(FI,DA,0))
|
|---|
| 20 | S DR="7" D ^DIE I $D(Y)!($D(DTOUT)) D:FLG RM L -^PS(FI,DA) G PT
|
|---|
| 21 | I X,X'=$P(REC,"^",8) S $P(REC,"^",7)=$P($G(^DIC(4,X,99)),"^"),DR="6////"_$P($G(^DIC(4,X,99)),"^") D ^DIE
|
|---|
| 22 | S DR="6" D ^DIE I $D(Y)!($D(DTOUT)) D:FLG RM L -^PS(52.91,DA) G PT
|
|---|
| 23 | I X,X'=$P(REC,"^",7),$$IEN^XUAF4(X) S DR="7////"_$$IEN^XUAF4(X) D ^DIE G INS
|
|---|
| 24 | S CDT=$P(REC,"^",3)
|
|---|
| 25 | S DR="2" D ^DIE I $D(Y)!($D(DTOUT)) L -^PS(FI,DA) G PT
|
|---|
| 26 | I CDT,X="" S DR="3////@" D ^DIE W !,"INACTIVATION REASON CODE: " G CONT
|
|---|
| 27 | I X S DR="3R",DIE("NO^")="" D ^DIE I $D(DTOUT) S DR="3////3" D ^DIE L -^PS(FI,DA) G PT
|
|---|
| 28 | CONT L -^PS(FI,DA)
|
|---|
| 29 | S Y=$S(FLG:DT,1:$P(REC,"^",2)) X ^DD("DD")
|
|---|
| 30 | W !!,UL,!,"DATE PHARMACY BENEFIT BEGAN: "_Y
|
|---|
| 31 | S Y=$P(REC,"^",6),Y=$S(Y="E":"EWL",Y="S":"SCHEDULED APPOINTMENT",Y="X":"EWL & SCHEDULED APPOINTMENT",Y="M":"MANUAL",1:"")
|
|---|
| 32 | W ?42,"WAIT TYPE: "_Y
|
|---|
| 33 | S Y=$P(REC,"^",5) I Y X ^DD("DD")
|
|---|
| 34 | W !,"DESIRED APPOINTMENT DATE: "_Y
|
|---|
| 35 | W !,"EXCLUSION REASON: " S Y=$P(REC,"^",9)
|
|---|
| 36 | W:Y=1 "ACTIVE RX"
|
|---|
| 37 | W:Y=2 "ACTUAL APPT. < 30 DAYS FROM DATE APPT. MADE"
|
|---|
| 38 | W:Y=3 "ACTIVE RX & ACTUAL APPT. < 30 DAYS FROM DATE APPT. MADE"
|
|---|
| 39 | S Y=$P(REC,"^",10) I Y X ^DD("DD")
|
|---|
| 40 | W !,"PRIMARY CARE SCHEDULE APT DATE: "_Y_" "_"RX #: "_$P(REC,"^",11)
|
|---|
| 41 | S Y=$P(REC,"^",12) I Y X ^DD("DD")
|
|---|
| 42 | W !,"DATE LETTER PRINTED: "_Y,!,UL
|
|---|
| 43 | G PT
|
|---|
| 44 | PTX K DIC,DIE,%DT,DR,DA Q
|
|---|
| 45 | RM ;
|
|---|
| 46 | ;W !?10,$C(7),"Required Data - Setting patient as Inactive"
|
|---|
| 47 | ;S DR="2////"_DT_";3////3" D ^DIE
|
|---|
| 48 | W !!,$C(7),"Required Data - deleting patient entry from TPB ELIGIBILITY (#52.91) File."
|
|---|
| 49 | K DIK S DIK="^PS(52.91,",DA=PSODFN D ^DIK K DIK,^PS(52.91,"AX",DT,DA)
|
|---|
| 50 | Q
|
|---|
