- PSOTPCEE ;BIR/MHA-transitional pharmacy benefit enter/edit ;07/01/03
- ;;7.0;OUTPATIENT PHARMACY;**145,153,227,268**;DEC 1997;Build 9
- ;;External reference to SDPHARM1 supported by DBIA 4196
- ;;External reference ^DIC(4 supported by DBIA 2251
- Q ;placed out of order by PSO87*227
- ST N PSODFN,FLG,PSODF,FI,INST,SNO,CDT,UL S FI=52.91,$P(UL,"=",79)="="
- PT K DIC,DIE,PSODFN,FLG,PSODF,REC,INST,SNO,CDT
- W ! S (DIC,DIE)=52.91,DIC(0)="QEALM",DLAYGO=FI
- ;S DIC("W")="W ?15,$$GET1^DIQ(2,+Y,.01)"
- D ^DIC G:+Y'>0 PTX S FLG=$P(Y,"^",3)
- S (PSODFN,DA)=+Y,DR=.351,DIC=2,DIQ="PSODF" D EN^DIQ1 K DIC,DR,DIQ
- I $G(PSODF(2,DA,.351))]"",FLG D G PT
- .W !!?10,$C(7),"Patient died on "_PSODF(2,PSODFN,.351)_" - Cannot be added to file!!",!
- .S DIK="^PS(52.91," D ^DIK K DIK
- 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
- S (INST,SNO)="" D:FLG
- .S X=$$DEF^SDPHARM1(DA) S:X INST=$P(X,"^"),SNO=$P(X,"^",2)
- .S DR="1////"_DT_";5////M;6////"_SNO_";7////"_INST D ^DIE
- INS S REC=$G(^PS(FI,DA,0))
- S DR="7" D ^DIE I $D(Y)!($D(DTOUT)) D:FLG RM L -^PS(FI,DA) G PT
- 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
- S DR="6" D ^DIE I $D(Y)!($D(DTOUT)) D:FLG RM L -^PS(52.91,DA) G PT
- I X,X'=$P(REC,"^",7),$$IEN^XUAF4(X) S DR="7////"_$$IEN^XUAF4(X) D ^DIE G INS
- S CDT=$P(REC,"^",3)
- S DR="2" D ^DIE I $D(Y)!($D(DTOUT)) L -^PS(FI,DA) G PT
- I CDT,X="" S DR="3////@" D ^DIE W !,"INACTIVATION REASON CODE: " G CONT
- I X S DR="3R",DIE("NO^")="" D ^DIE I $D(DTOUT) S DR="3////3" D ^DIE L -^PS(FI,DA) G PT
- CONT L -^PS(FI,DA)
- S Y=$S(FLG:DT,1:$P(REC,"^",2)) X ^DD("DD")
- W !!,UL,!,"DATE PHARMACY BENEFIT BEGAN: "_Y
- S Y=$P(REC,"^",6),Y=$S(Y="E":"EWL",Y="S":"SCHEDULED APPOINTMENT",Y="X":"EWL & SCHEDULED APPOINTMENT",Y="M":"MANUAL",1:"")
- W ?42,"WAIT TYPE: "_Y
- S Y=$P(REC,"^",5) I Y X ^DD("DD")
- W !,"DESIRED APPOINTMENT DATE: "_Y
- W !,"EXCLUSION REASON: " S Y=$P(REC,"^",9)
- W:Y=1 "ACTIVE RX"
- W:Y=2 "ACTUAL APPT. < 30 DAYS FROM DATE APPT. MADE"
- W:Y=3 "ACTIVE RX & ACTUAL APPT. < 30 DAYS FROM DATE APPT. MADE"
- S Y=$P(REC,"^",10) I Y X ^DD("DD")
- W !,"PRIMARY CARE SCHEDULE APT DATE: "_Y_" "_"RX #: "_$P(REC,"^",11)
- S Y=$P(REC,"^",12) I Y X ^DD("DD")
- W !,"DATE LETTER PRINTED: "_Y,!,UL
- G PT
- PTX K DIC,DIE,%DT,DR,DA Q
- RM ;
- ;W !?10,$C(7),"Required Data - Setting patient as Inactive"
- ;S DR="2////"_DT_";3////3" D ^DIE
- W !!,$C(7),"Required Data - deleting patient entry from TPB ELIGIBILITY (#52.91) File."
- K DIK S DIK="^PS(52.91,",DA=PSODFN D ^DIK K DIK,^PS(52.91,"AX",DT,DA)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOTPCEE 2645 printed Feb 19, 2025@00:02:10 Page 2
- PSOTPCEE ;BIR/MHA-transitional pharmacy benefit enter/edit ;07/01/03
- +1 ;;7.0;OUTPATIENT PHARMACY;**145,153,227,268**;DEC 1997;Build 9
- +2 ;;External reference to SDPHARM1 supported by DBIA 4196
- +3 ;;External reference ^DIC(4 supported by DBIA 2251
- +4 ;placed out of order by PSO87*227
- QUIT
- ST NEW PSODFN,FLG,PSODF,FI,INST,SNO,CDT,UL
- SET FI=52.91
- SET $PIECE(UL,"=",79)="="
- PT KILL DIC,DIE,PSODFN,FLG,PSODF,REC,INST,SNO,CDT
- +1 WRITE !
- SET (DIC,DIE)=52.91
- SET DIC(0)="QEALM"
- SET DLAYGO=FI
- +2 ;S DIC("W")="W ?15,$$GET1^DIQ(2,+Y,.01)"
- +3 DO ^DIC
- if +Y'>0
- GOTO PTX
- SET FLG=$PIECE(Y,"^",3)
- +4 SET (PSODFN,DA)=+Y
- SET DR=.351
- SET DIC=2
- SET DIQ="PSODF"
- DO EN^DIQ1
- KILL DIC,DR,DIQ
- +5 IF $GET(PSODF(2,DA,.351))]""
- IF FLG
- Begin DoDot:1
- +6 WRITE !!?10,$CHAR(7),"Patient died on "_PSODF(2,PSODFN,.351)_" - Cannot be added to file!!",!
- +7 SET DIK="^PS(52.91,"
- DO ^DIK
- KILL DIK
- End DoDot:1
- GOTO PT
- +8 LOCK +^PS(FI,DA):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
- IF '$TEST
- WRITE $CHAR(7),!!,"Patient Data is Being Edited by Another User!",!
- GOTO PT
- +9 SET (INST,SNO)=""
- if FLG
- Begin DoDot:1
- +10 SET X=$$DEF^SDPHARM1(DA)
- if X
- SET INST=$PIECE(X,"^")
- SET SNO=$PIECE(X,"^",2)
- +11 SET DR="1////"_DT_";5////M;6////"_SNO_";7////"_INST
- DO ^DIE
- End DoDot:1
- INS SET REC=$GET(^PS(FI,DA,0))
- +1 SET DR="7"
- DO ^DIE
- IF $DATA(Y)!($DATA(DTOUT))
- if FLG
- DO RM
- LOCK -^PS(FI,DA)
- GOTO PT
- +2 IF X
- IF X'=$PIECE(REC,"^",8)
- SET $PIECE(REC,"^",7)=$PIECE($GET(^DIC(4,X,99)),"^")
- SET DR="6////"_$PIECE($GET(^DIC(4,X,99)),"^")
- DO ^DIE
- +3 SET DR="6"
- DO ^DIE
- IF $DATA(Y)!($DATA(DTOUT))
- if FLG
- DO RM
- LOCK -^PS(52.91,DA)
- GOTO PT
- +4 IF X
- IF X'=$PIECE(REC,"^",7)
- IF $$IEN^XUAF4(X)
- SET DR="7////"_$$IEN^XUAF4(X)
- DO ^DIE
- GOTO INS
- +5 SET CDT=$PIECE(REC,"^",3)
- +6 SET DR="2"
- DO ^DIE
- IF $DATA(Y)!($DATA(DTOUT))
- LOCK -^PS(FI,DA)
- GOTO PT
- +7 IF CDT
- IF X=""
- SET DR="3////@"
- DO ^DIE
- WRITE !,"INACTIVATION REASON CODE: "
- GOTO CONT
- +8 IF X
- SET DR="3R"
- SET DIE("NO^")=""
- DO ^DIE
- IF $DATA(DTOUT)
- SET DR="3////3"
- DO ^DIE
- LOCK -^PS(FI,DA)
- GOTO PT
- CONT LOCK -^PS(FI,DA)
- +1 SET Y=$SELECT(FLG:DT,1:$PIECE(REC,"^",2))
- XECUTE ^DD("DD")
- +2 WRITE !!,UL,!,"DATE PHARMACY BENEFIT BEGAN: "_Y
- +3 SET Y=$PIECE(REC,"^",6)
- SET Y=$SELECT(Y="E":"EWL",Y="S":"SCHEDULED APPOINTMENT",Y="X":"EWL & SCHEDULED APPOINTMENT",Y="M":"MANUAL",1:"")
- +4 WRITE ?42,"WAIT TYPE: "_Y
- +5 SET Y=$PIECE(REC,"^",5)
- IF Y
- XECUTE ^DD("DD")
- +6 WRITE !,"DESIRED APPOINTMENT DATE: "_Y
- +7 WRITE !,"EXCLUSION REASON: "
- SET Y=$PIECE(REC,"^",9)
- +8 if Y=1
- WRITE "ACTIVE RX"
- +9 if Y=2
- WRITE "ACTUAL APPT. < 30 DAYS FROM DATE APPT. MADE"
- +10 if Y=3
- WRITE "ACTIVE RX & ACTUAL APPT. < 30 DAYS FROM DATE APPT. MADE"
- +11 SET Y=$PIECE(REC,"^",10)
- IF Y
- XECUTE ^DD("DD")
- +12 WRITE !,"PRIMARY CARE SCHEDULE APT DATE: "_Y_" "_"RX #: "_$PIECE(REC,"^",11)
- +13 SET Y=$PIECE(REC,"^",12)
- IF Y
- XECUTE ^DD("DD")
- +14 WRITE !,"DATE LETTER PRINTED: "_Y,!,UL
- +15 GOTO PT
- PTX KILL DIC,DIE,%DT,DR,DA
- QUIT
- RM ;
- +1 ;W !?10,$C(7),"Required Data - Setting patient as Inactive"
- +2 ;S DR="2////"_DT_";3////3" D ^DIE
- +3 WRITE !!,$CHAR(7),"Required Data - deleting patient entry from TPB ELIGIBILITY (#52.91) File."
- +4 KILL DIK
- SET DIK="^PS(52.91,"
- SET DA=PSODFN
- DO ^DIK
- KILL DIK,^PS(52.91,"AX",DT,DA)
- +5 QUIT