117 lines
7.1 KiB
Mathematica
117 lines
7.1 KiB
Mathematica
PSOTPCRX ;BIR/RTR-Enrollment and Active Rx check ;08/01/03
|
|
;;7.0;OUTPATIENT PHARMACY;**145**;DEC 1997
|
|
;External reference to PS(55 supported by DBIA 2228
|
|
;External reference to PSDRUG( supported by DBIA 221
|
|
;External reference to XTMP("SDPSO145" supported by DBIA's 4193,4194
|
|
;External references to DGENA supported by DBIA 3812
|
|
;External reference to DGENA4 supported by DBIA 4192
|
|
;
|
|
;Enrollment check for TPC Eligibility
|
|
ENR(PSOENPAT,PSOENRDT) ;;If not enrolled, Patient does not go in file
|
|
I '$G(PSOENPAT) Q 0
|
|
S:'$G(PSOENRDT) PSOENRDT=$$DT^XLFDT
|
|
N PSODGENR,PSODDONE,PSODRIEN,PSODGRDT
|
|
S PSODRIEN=$$FINDCUR^DGENA(PSOENPAT),PSODDONE=0
|
|
Q:'PSODRIEN 0
|
|
F Q:PSODDONE D
|
|
.I '$$GET^DGENA(PSODRIEN,.PSODGENR) S PSODDONE=-1 Q
|
|
.S PSODGRDT=$G(PSODGENR("APP")) S:PSODGRDT="" PSODGRDT=$G(PSODGENR("DATE"))
|
|
.I PSODGRDT,PSODGRDT<PSOENRDT S PSODDONE=1 S:$$CATEGORY^DGENA4(PSOENPAT,$G(PSODGENR("STATUS")))="N" PSODDONE=-1 Q
|
|
.S PSODRIEN=$$FINDPRI^DGENA(PSODRIEN)
|
|
.I 'PSODRIEN S PSODDONE=-1 Q
|
|
.K PSODGENR
|
|
Q $S(PSODDONE<1:0,1:1)
|
|
Q
|
|
;Active Rx check for eligibility
|
|
RX(PSOTRXPT) ;
|
|
I '$G(PSOTRXPT) Q 0
|
|
N PSOTRXDT,PSOTRXDG,PSOTRX,PSOTRX1,PSOTRX2,X,X1,X2
|
|
S PSOTRX=0
|
|
;Using Oct 22 minus 485 days
|
|
S X1=3031022,X2=-486 D C^%DTC S PSOTRXDT=X K X,X1,X2
|
|
F PSOTRX1=PSOTRXDT:0 S PSOTRX1=$O(^PS(55,PSOTRXPT,"P","A",PSOTRX1)) Q:'PSOTRX1!(PSOTRX) S PSOTRX2="" F S PSOTRX2=$O(^PS(55,PSOTRXPT,"P","A",PSOTRX1,PSOTRX2)) Q:PSOTRX2=""!(PSOTRX) D
|
|
.I $P($G(^PSRX(PSOTRX2,0)),"^",2)=PSOTRXPT,$P($G(^(0)),"^")'="",$P($G(^("STA")),"^")'="",$P($G(^("STA")),"^")'=13 D
|
|
..I $P($G(^PSRX(PSOTRX2,0)),"^",13),$P($G(^(0)),"^",13)<PSOTRXDT Q
|
|
..S PSOTRXDG=$P($G(^PSRX(PSOTRX2,0)),"^",6)
|
|
..I PSOTRXDG,$P($G(^PSDRUG(PSOTRXDG,0)),"^",3)'["S",$P($G(^(0)),"^",3)'["I" S PSOTRX=1 S ^XTMP("SDPSO145","ACRX",PSOTRXPT)=$P($G(^PSRX(PSOTRX2,0)),"^")
|
|
Q PSOTRX
|
|
SCH ;
|
|
I '$D(^XTMP("SDPSO145","PAT","S")) Q
|
|
;Scheduling
|
|
N PSOWAITT,PSOTPDRD,PSOACIRX,PSOXLP1,PSOXLP2,PSOXLP3,PSOXLESS,PSOTX1,PSOTX2,PSOTX3,PSOLXQT,PSOXNRLD,PSOXTCRX
|
|
S PSOTX1="" F S PSOTX1=$O(^XTMP("SDPSO145","PAT","S",PSOTX1)) Q:PSOTX1="" D
|
|
.S PSOXLESS=0 S PSOXLP1="" F S PSOXLP1=$O(^XTMP("SDPSO145","PAT","S",PSOTX1,PSOXLP1)) Q:PSOXLP1=""!(PSOXLESS) S PSOXLP2="" F S PSOXLP2=$O(^XTMP("SDPSO145","PAT","S",PSOTX1,PSOXLP1,PSOXLP2)) Q:PSOXLP2=""!(PSOXLESS) D
|
|
..I $G(^XTMP("SDPSO145","PAT","S",PSOTX1,PSOXLP1,PSOXLP2)) S PSOXLESS=1
|
|
.S PSOLXQT=0
|
|
.S PSOTX2="" F S PSOTX2=$O(^XTMP("SDPSO145","PAT","S",PSOTX1,PSOTX2)) Q:PSOTX2=""!(PSOLXQT) S PSOTX3="" F S PSOTX3=$O(^XTMP("SDPSO145","PAT","S",PSOTX1,PSOTX2,PSOTX3)) Q:PSOTX3=""!(PSOLXQT) D
|
|
..S PSOTPDRD=$P($G(^XTMP("SDPSO145","PAT","S",PSOTX1,PSOTX2,PSOTX3)),"^",3)
|
|
..S PSOXNRLD=1 S:'$D(^XTMP("SDPSO145","NOTEN",PSOTX1)) PSOXNRLD=$$ENR(PSOTX1,3030725) I $D(^XTMP("SDPSO145","NOTEN",PSOTX1))!('$G(PSOXNRLD)) D Q
|
|
...S ^XTMP("SDPSO145","NOTEN",PSOTX1)="",PSOLXQT=1
|
|
..S PSOXTCRX=0 S:'$D(^XTMP("SDPSO145","ACRX",PSOTX1)) PSOXTCRX=$$RX(PSOTX1) I PSOXTCRX!($D(^XTMP("SDPSO145","ACRX",PSOTX1))) D Q
|
|
...S PSOACIRX=$G(^XTMP("SDPSO145","ACRX",PSOTX1))
|
|
...;S PSOLXQT=1
|
|
...I $D(^PS(52.91,PSOTX1,0)) D K PSOACIRX Q
|
|
....D:$D(^XTMP("SDPSO145","PAT","E",PSOTX1))!($D(^XTMP("SDPSO145","PAT","S",PSOTX1))) DATE
|
|
....I $D(^XTMP("SDPSO145","PAT","E",PSOTX1)) K DA,DR,DIE S DIE="^PS(52.91,",DA=PSOTX1,DR="5////"_"X" D ^DIE K DA,DR,DIE
|
|
...D SNM
|
|
...I $G(PSOTPSNM)="" S ^XTMP("SDPSO145","PROB1",PSOTX1)=" (With Exclusion)" K PSOTPSNM K PSOACIRX Q
|
|
...S PSOWAITT=$S($D(^XTMP("SDPSO145","PAT","E",PSOTX1)):"X",1:"S")
|
|
...K DIC S DIC="^PS(52.91,",DIC(0)="L",(X,DINUM)=PSOTX1,DIC("DR")="1////"_DT_";2////"_DT_";3////"_7_";4////"_PSOTPDRD_";6////"_PSOTPSNM_";7////"_PSOTX2_";9////"_PSOTX3_";8////"_$S($G(PSOXLESS):3,1:1)_";10////"_$G(PSOACIRX) D
|
|
....S DIC("DR")=DIC("DR")_";5////"_PSOWAITT K DD,DO D FILE^DICN
|
|
....K PSOWAITT,PSOTPSNM,PSOACIRX,DO,DD,DIC,DIE,X,DINUM
|
|
....I Y'>0 S ^XTMP("SDPSO145","PROB",PSOTX1)=" (With Exlusion)" Q
|
|
....S PSOITOT=$G(PSOITOT)+1
|
|
..I PSOXLESS D Q
|
|
...;S PSOLXQT=1
|
|
...I $D(^PS(52.91,PSOTX1,0)) D Q
|
|
....D:$D(^XTMP("SDPSO145","PAT","E",PSOTX1))!($D(^XTMP("SDPSO145","PAT","S",PSOTX1))) DATE
|
|
....I $D(^XTMP("SDPSO145","PAT","E",PSOTX1)) K DIE,DA,DR S DIE="^PS(52.91,",DA=PSOTX1,DR="2////"_DT_";5////"_"X"_";3////"_7_";8////"_$S($P($G(^PS(52.91,PSOTX1,0)),"^",9)=1:"3",$P($G(^(0)),"^",9)=3:"3",1:"2")
|
|
....D ^DIE K DA,DR,DIE
|
|
...D SNM
|
|
...I $G(PSOTPSNM)="" S ^XTMP("SDPSO145","PROB1",PSOTX1)=" (With Exclusion)" K PSOTPSNM Q
|
|
...K DIC S DIC="^PS(52.91,",DIC(0)="L",(X,DINUM)=PSOTX1,DIC("DR")="1////"_DT_";2////"_DT_";3////"_7_";4////"_PSOTPDRD_";5////"_"S"_";6////"_PSOTPSNM_";7////"_PSOTX2_";9////"_PSOTX3_";8////"_2 K DD,DO D FILE^DICN K DD,DO,DIE,X,DINUM D
|
|
....K PSOTPSNM
|
|
....I Y'>0 S ^XTMP("SDPSO145","PROB",PSOTX1)=" (With Exclusion)" Q
|
|
....S PSOITOT=$G(PSOITOT)+1
|
|
..I $D(^PS(52.91,PSOTX1,0)) D Q
|
|
...I $D(^XTMP("SDPSO145","PAT","E",PSOTX1)) K DIE,DA,DR S DIE="^PS(52.91,",DA=PSOTX1,DR="5////"_"X" D ^DIE K DA,DIR,DR
|
|
...D:$D(^XTMP("SDPSO145","PAT","E",PSOTX1))!($D(^XTMP("SDPSO145","PAT","S",PSOTX1))) DATE
|
|
...;I $P($G(^PS(52.91,PSOTX1,0)),"^",10) S PSOLXQT=1 Q
|
|
...;I PSOTX2=$P($G(^PS(52.91,PSOTX1,0)),"^",8) K DIE,DA,DR S DA=PSOTX1,DIE="^PS(52.91,",DR="9////"_PSOTX3 D ^DIE K DIE,DA,DR S PSOLXQT=1 Q
|
|
...;D SNM I $G(PSOTPSNM)="" Q
|
|
...;K DA,DIE,DR S DIE="^PS(52.91,",DA=PSOTX1,DR="4////"_"@"_";6////"_PSOTPSNM_";7////"_PSOTX2_";9////"_PSOTX3 D ^DIE K DA,DR,DIE
|
|
...;K PSOTPSNM S PSOLXQT=1 Q
|
|
..D SNM
|
|
..I $G(PSOTPSNM)="" S ^XTMP("SDPSO145","PROB1",PSOTX1)="" K PSOTPSNM Q
|
|
..K DIC S DIC="^PS(52.91,",DIC(0)="L",(X,DINUM)=PSOTX1,DIC("DR")="1////"_DT_";4////"_PSOTPDRD_";5////"_"S"_";6////"_PSOTPSNM_";7////"_PSOTX2_";9////"_PSOTX3 K DD,DO D FILE^DICN K DD,DO,DIE,X,DINUM D
|
|
...K PSOTPSNM
|
|
...I Y'>0 S ^XTMP("SDPSO145","PROB",PSOTX1)="" Q
|
|
...S PSOETOT=$G(PSOETOT)+1
|
|
Q
|
|
SNM ;
|
|
K PSOTPSNM,PSOSTATI,DIC,DIQ,DD,DR S DIC=4,DR="99",DA=+PSOTX2,DIQ(0)="I",DIQ="PSOSTATI" D EN^DIQ1 S PSOTPSNM=$G(PSOSTATI(4,+PSOTX2,99,"I")) K DIC,DIQ,DR,DA,PSOSTATI
|
|
Q
|
|
DATE ;
|
|
I $P($G(^PS(52.91,PSOTX1,0)),"^",10),PSOTX3'<$P(^(0),"^",10) Q
|
|
I PSOTX2=$P($G(^PS(52.91,PSOTX1,0)),"^",8) K DA,DIE,DR S DIE="^PS(52.91,",DA=PSOTX1,DR="9////"_PSOTX3_";4////"_"@" D ^DIE K DA,DR,DIE D Q
|
|
.S DIE="^PS(52.91,",DA=PSOTX1,DR="4////"_PSOTPDRD D ^DIE K DA,DR,DIE
|
|
D SNM
|
|
I $G(PSOTPSNM)="" K PSOTPSNM Q
|
|
K DA,DR,DIE S DIE="^PS(52.91,",DA=PSOTX1,DR="4////"_"@"_";6////"_PSOTPSNM_";7////"_PSOTX2_";9////"_PSOTX3 D ^DIE K DA,DR,DIE
|
|
K DA,DR,DIE S DIE="^PS(52.91,",DA=PSOTX1,DR="4////"_PSOTPDRD D ^DIE K DA,DR,DIE
|
|
K PSOTPSNM
|
|
Q
|
|
EWL ;
|
|
N PSOTPRXX
|
|
K PSOTPSNM,PSOSTATI,DIC,DIQ,DD,DR S DIC=4,DR="99",DA=+PSOTG2,DIQ(0)="I",DIQ="PSOSTATI" D EN^DIQ1 S PSOTPSNM=$G(PSOSTATI(4,+PSOTG2,99,"I")) K DIC,DIQ,DR,DA,PSOSTATI
|
|
I $G(PSOTPSNM)="" S ^XTMP("SDPSO145","PROB1",PSOTG1)="" K PSOTPSNM Q
|
|
S PSOTPRXX=$G(^XTMP("SDPSO145","ACRX",PSOTG1))
|
|
K DIE,DA,DR,DIC
|
|
S DIC="^PS(52.91,",DIC(0)="L",(X,DINUM)=PSOTG1,DIC("DR")="1////"_DT_";2////"_DT_";3////"_7_";5////"_"E"_";6////"_PSOTPSNM_";7////"_PSOTG2_";8////"_1_";10////"_PSOTPRXX S:'$G(PSONODAD) DIC("DR")=DIC("DR")_";4////"_PSOTG3
|
|
K DD,DO D FILE^DICN K DD,DO,DIE,X,DINUM,PSOTPSNM
|
|
I Y'>0 S ^XTMP("SDPSO145","PROB",PSOTG1)="" Q
|
|
S PSOITOT=$G(PSOITOT)+1
|
|
K ^XTMP("SDPSO145","PROB",PSOTG1)
|
|
K ^XTMP("SDPSO145","PROB1",PSOTG1)
|
|
Q
|