159 lines
8.5 KiB
Mathematica
159 lines
8.5 KiB
Mathematica
|
PSO55FX2 ;ISC-BHAM/MHA - cleanup of bad p nodes and mismatched Rxs in file 55 ; 07/26/2001
|
||
|
|
;;7.0;OUTPATIENT PHARMACY;**69**;DEC 1997
|
||
|
|
;External reference to ^PS(55 is supported by DBIA 2228
|
||
|
|
;External reference ^DGPM("AMV1" is supported by DBIA 2249
|
||
|
|
Q
|
||
|
|
BEG ;
|
||
|
|
I '$D(DUZ) W !!!!,"* DUZ NOT DEFINED - QUITTING *" Q
|
||
|
|
D MSG^PSO55FX3
|
||
|
|
K %DT D NOW^%DTC S %DT="RAEX",%DT(0)=%,%DT("A")="Select the Date/Time to queue this job: "
|
||
|
|
D ^%DT K %DT
|
||
|
|
I $D(DTOUT)!(Y<0) W !!!?10,"Job not queued - quitting!" Q
|
||
|
|
S ZTDTH=$G(Y),ZTSAVE("DUZ")="",ZTIO="",ZTRTN="EN^PSO55FX2",ZTDESC="Cleanup of bad 'P' cross-references in Pharmacy Patient file"
|
||
|
|
D ^%ZTLOAD W:$D(ZTSK) !!,"Task Queued To Run!",!
|
||
|
|
Q
|
||
|
|
EN ;
|
||
|
|
I $G(^XTMP("PSO2",69))="PH1" D PH2^PSO55FX3 Q
|
||
|
|
S TY="PSO",JN=69 S (DFN,ZA,ZB,ZC)=0
|
||
|
|
I '$D(^XTMP(TY,JN)) S X1=DT,X2=+90 D C^%DTC S ^XTMP(TY,JN,0)=$G(X)_"^"_DT G EN1
|
||
|
|
I $D(^XTMP(TY,JN,1)) D
|
||
|
|
.S DFN=$P(^XTMP(TY,JN,1),"^") S:'DFN DFN=0
|
||
|
|
.S ZA=$P(^XTMP(TY,JN,1),"^",2) S:'ZA ZA=0
|
||
|
|
.S ZB=$P(^XTMP(TY,JN,1),"^",3) S:'ZB ZB=0
|
||
|
|
.S ZC=$P(^XTMP(TY,JN,1),"^",4) S:'ZC ZC=0
|
||
|
|
EN1 S STA="ACTIVE^NON-VERIFIED^REFILL^HOLD^NON-VERIFIED^SUSPENDED^^^^^DONE^EXPIRED^DISCONTINUED^DELETED^DISCONTINUED^DISCONTINUE (EDIT)^PROVIDER HOLD"
|
||
|
|
F S DFN=$O(^PS(55,DFN)) Q:'DFN D CHK1,CHK2 S ^XTMP(TY,JN,1)=DFN_"^"_ZA_"^"_ZB_"^"_ZC
|
||
|
|
D SMAIL S ^XTMP("PSO2",69)="PH1" D PH2^PSO55FX3
|
||
|
|
Q
|
||
|
|
CHK1 ;for every patient go through the "P" x-ref
|
||
|
|
K XZ S (RB,I)=0 F S I=$O(^PS(55,DFN,"P",I)) Q:'I S RX=$P($G(^(I,0)),"^") D:RX
|
||
|
|
.;checks for non-existing Rxs or Rxs with no header record & if found clean it up
|
||
|
|
.I '$D(^PSRX(RX)) S RB=1,ZA=ZA+1,XZ(RX)="" K ^PS(55,DFN,"P",I,0) Q
|
||
|
|
.I '$D(^PSRX(RX,0)) S RB=1,ZA=ZA+1,XZ(RX)="" K ^PS(55,DFN,"P",I,0) Q
|
||
|
|
.;checks for patient mis-match
|
||
|
|
.I DFN'=+$P(^PSRX(RX,0),"^",2) D
|
||
|
|
..S ZA=ZA+1,RB=1,XZ(RX)="" K ^PS(55,DFN,"P",I,0)
|
||
|
|
..D:+$P($G(^PSRX(RX,"STA")),"^")=12 ALOG
|
||
|
|
D:RB RBP
|
||
|
|
Q
|
||
|
|
ALOG ;
|
||
|
|
S CDFN=+$P(^PSRX(RX,0),"^",2)
|
||
|
|
Q:$P($G(^DPT(CDFN,.35)),"^")
|
||
|
|
S (II,JJ,CT)=0,AL="ZZZ"
|
||
|
|
F S II=$O(^PSRX(RX,"A",II)) Q:'II S:$P($G(^(II,0)),"^",5)["Auto Discontinued on Admission" JJ=II
|
||
|
|
I JJ S CDT=$P($G(^PSRX(RX,"A",JJ,0)),"^") Q:'CDT D
|
||
|
|
.S X1=$E(CDT,1,7),X2=-3 D C^%DTC S SDT=X-.01,EDT=X_".99999"
|
||
|
|
.F S SDT=$O(^DGPM("AMV1",SDT)) Q:'SDT!(SDT>EDT)!(CT) D
|
||
|
|
..S PDFN=0 F S PDFN=$O(^DGPM("AMV1",SDT,PDFN)) Q:'PDFN!(PDFN=CDFN)
|
||
|
|
..S:+PDFN=CDFN CT=1
|
||
|
|
Q:CT
|
||
|
|
S:JJ AL="Auto Discontinued on Admission" S (II,JJ)=0
|
||
|
|
F S II=$O(^PSRX(RX,"A",II)) Q:'II S:$P($G(^(II,0)),"^",5)["Auto Discontinued Due" JJ=II
|
||
|
|
S:JJ AL=$P(^PSRX(RX,"A",JJ,0),"^",5)
|
||
|
|
S DIV=$P($G(^PSRX(RX,2)),"^",9) S:DIV="" DIV=998899
|
||
|
|
CREC ;
|
||
|
|
S SSN=$P($G(^DPT(CDFN,0)),"^",9) S:SSN="" SSN="N/A"
|
||
|
|
S NAME=$P($G(^DPT(CDFN,0)),"^")_" ("_SSN_")" S:NAME="" NAME="N/A"
|
||
|
|
;S STAT=$P(STA,"^",$P($G(^PSRX(RX,"STA")),"^")+1) S:STAT="" STAT="N/A"
|
||
|
|
S:'$D(^XTMP(TY,JN,2,DIV,AL,CDFN,RX)) ^XTMP(TY,JN,2,DIV,AL,CDFN,RX)=NAME_"^"_$P(^PSRX(RX,0),"^")_"^"_$S(AL="ZZZ":"",1:AL),ZC=ZC+1
|
||
|
|
S ^XTMP(TY,JN,"Z",DIV,CDFN,RX)=""
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
CHK2 ;for every patient go through the "P","A" x-ref
|
||
|
|
S J=0 F S J=$O(^PS(55,DFN,"P","A",J)) Q:'J S RX=0 F S RX=$O(^PS(55,DFN,"P","A",J,RX)) Q:'RX D
|
||
|
|
.;checks for non-existing Rxs or Rxs with no header record & if found clean it up
|
||
|
|
.I '$D(^PSRX(RX)) S:'$D(XZ(RX)) ZB=ZB+1 K ^PS(55,DFN,"P","A",J,RX) Q
|
||
|
|
.I '$D(^PSRX(RX,0)) S:'$D(XZ(RX)) ZB=ZB+1 K ^PS(55,DFN,"P","A",J,RX) Q
|
||
|
|
.;checks for patient mismatch
|
||
|
|
.I DFN'=+$P(^PSRX(RX,0),"^",2) D
|
||
|
|
..S:'$D(XZ(RX)) ZB=ZB+1 K ^PS(55,DFN,"P","A",J,RX)
|
||
|
|
..D:+$P($G(^PSRX(RX,"STA")),"^")=12 ALOG
|
||
|
|
K XZ Q
|
||
|
|
RBP ;rebuild the "P" header rec
|
||
|
|
S (NR,LR,I)=0 F S I=$O(^PS(55,DFN,"P",I)) Q:'I S LR=I,NR=NR+1
|
||
|
|
S ^PS(55,DFN,"P",0)="^55.03PA^"_LR_"^"_NR
|
||
|
|
K NR,LR,RB Q
|
||
|
|
;
|
||
|
|
SMAIL ;
|
||
|
|
S ZZ="PSOFX" K ^TMP(ZZ,$J),XMY
|
||
|
|
I ZA!(ZB)!(ZC) D
|
||
|
|
.;S ^TMP(ZZ,$J,1)="**************************************************"
|
||
|
|
.S ^TMP(ZZ,$J,2)="*** Following cleanup has been done: ***"
|
||
|
|
.S ^TMP(ZZ,$J,3)="*** ***"
|
||
|
|
.S ^TMP(ZZ,$J,4)="*** bad P-XREF COUNT "_$E(ZA_" ",1,6)_" ***"
|
||
|
|
.S ^TMP(ZZ,$J,5)="*** bad PA-XREF COUNT "_$E(ZB_" ",1,6)_" ***"
|
||
|
|
.S ^TMP(ZZ,$J,6)="*** mismatched PATIENT COUNT "_$E(ZC_" ",1,6)_" ***"
|
||
|
|
.S ^TMP(ZZ,$J,7)="*** ***"
|
||
|
|
.I ZC D
|
||
|
|
..S ^TMP(ZZ,$J,8)="*** The count of mismatched patients may ***"
|
||
|
|
..S ^TMP(ZZ,$J,9)="*** include multiple counts for the same ***"
|
||
|
|
..S ^TMP(ZZ,$J,10)="*** patient since bad nodes from more than ***"
|
||
|
|
..S ^TMP(ZZ,$J,11)="*** one patient could point to different ***"
|
||
|
|
..S ^TMP(ZZ,$J,12)="*** prescriptions for the same 'good' ***"
|
||
|
|
..S ^TMP(ZZ,$J,13)="*** patient entry in the PRESCRIPTION ***"
|
||
|
|
..S ^TMP(ZZ,$J,14)="*** file (#52). ***"
|
||
|
|
.;S ^TMP(ZZ,$J,15)="**************************************************"
|
||
|
|
.S ^TMP(ZZ,$J,16)=""
|
||
|
|
.I ZC D
|
||
|
|
..S ^TMP(ZZ,$J,17)="A separate message has been sent for the following"
|
||
|
|
..S ^TMP(ZZ,$J,18)="divisions. Each has one or more mismatched patients"
|
||
|
|
..S ^TMP(ZZ,$J,19)="that must be reviewed for inaccurate data."
|
||
|
|
..S ^TMP(ZZ,$J,20)="",XX=21
|
||
|
|
..K XY S J=0 F S J=$O(^XTMP(TY,JN,"Z",J)) Q:'J D
|
||
|
|
...S DIV=$P($G(^PS(59,J,0)),"^")
|
||
|
|
...S (I,L)=0 F S I=$O(^XTMP(TY,JN,"Z",J,I)) Q:'I S L=L+1
|
||
|
|
...S ^TMP(ZZ,$J,XX)=" "_DIV_": "_L,XX=XX+1,XY(J)=L
|
||
|
|
E D
|
||
|
|
.;S ^TMP(ZZ,$J,1)="**************************************************"
|
||
|
|
.S ^TMP(ZZ,$J,2)="*** No prescriptions were found with possible ***"
|
||
|
|
.S ^TMP(ZZ,$J,3)="*** bad 'P' or 'P','A' x-refs or prescriptions ***"
|
||
|
|
.S ^TMP(ZZ,$J,4)="*** associated with the wrong patient. ***"
|
||
|
|
.;S ^TMP(ZZ,$J,5)="**************************************************"
|
||
|
|
S XMY(DUZ)="",XMY("G.PL2 PATCH TRACKING@FORUM.VA.GOV")=""
|
||
|
|
S XMSUB="PSO*7*69 - "_$P($$SITE^VASITE(),"^",2)
|
||
|
|
S XMDUZ="Outpatient Pharmacy Patch 69"
|
||
|
|
S XMTEXT="^TMP(ZZ,$J," D ^XMD K XMY,^TMP(ZZ,$J)
|
||
|
|
I $D(^XTMP(TY,JN,2)) S J=0 F S J=$O(^XTMP(TY,JN,2,J)) Q:'J D
|
||
|
|
.S DIV=$P($G(^PS(59,J,0)),"^")
|
||
|
|
.S ^TMP(ZZ,$J,J,1)="This message is comprised of two sections. Section 1 lists prescriptions that"
|
||
|
|
.S ^TMP(ZZ,$J,J,2)="may have been automatically discontinued by mistake, either by a Date of Death"
|
||
|
|
.S ^TMP(ZZ,$J,J,3)="entry or by the Autocancel on Admission action for a different patient. The"
|
||
|
|
.S ^TMP(ZZ,$J,J,4)="second section lists other discontinued prescriptions."
|
||
|
|
.S ^TMP(ZZ,$J,J,5)=""
|
||
|
|
.S ^TMP(ZZ,$J,J,6)="Please review the following DISCONTINUED prescriptions for the "
|
||
|
|
.S ^TMP(ZZ,$J,J,8)=DIV_" (division name) Outpatient Site."
|
||
|
|
.S ^TMP(ZZ,$J,J,9)=""
|
||
|
|
.S ^TMP(ZZ,$J,J,10)="TOTAL COUNT OF UNIQUE PATIENT IS "_$G(XY(J))
|
||
|
|
.S ^TMP(ZZ,$J,J,11)=""
|
||
|
|
.S YY=0,$E(S1,36)="",$E(S2,12)="",K="",$P(UL,"=",66)=""
|
||
|
|
.S ^TMP(ZZ,$J,J,12)=UL,^TMP(ZZ,$J,J,13)="SECTION 1",^TMP(ZZ,$J,J,14)=""
|
||
|
|
.S XX=15 F S K=$O(^XTMP(TY,JN,2,J,K)) Q:K="" D
|
||
|
|
..D:'YY
|
||
|
|
...S ^TMP(ZZ,$J,J,XX)="Following prescriptions may have been automatically discontinued by mistake,",XX=XX+1
|
||
|
|
...S ^TMP(ZZ,$J,J,XX)="either by a Date of Death entry or by the Autocancel on Admission action for",XX=XX+1
|
||
|
|
...S ^TMP(ZZ,$J,J,XX)="a different patient.",XX=XX+1
|
||
|
|
...S ^TMP(ZZ,$J,J,XX)="",XX=XX+1
|
||
|
|
...S ^TMP(ZZ,$J,J,XX)=$E("NAME (SSN#)"_S1,1,35)_$E("Rx #"_S2,1,12)_$S(K="ZZZ":"",1:"Discontinued Reason"),XX=XX+1
|
||
|
|
...S ^TMP(ZZ,$J,J,XX)="",XX=XX+1 S:K["Auto Discontinued" YY=1
|
||
|
|
..D:K="ZZZ"
|
||
|
|
...I YY S ^TMP(ZZ,$J,J,XX)="",XX=XX+1,YY=0
|
||
|
|
...E S ^TMP(ZZ,$J,J,XX)="There were no entries that were automatically discontinued.",XX=XX+1,^TMP(ZZ,$J,J,XX)="",XX=XX+1
|
||
|
|
...S ^TMP(ZZ,$J,J,XX)=UL,XX=XX+1
|
||
|
|
...S ^TMP(ZZ,$J,J,XX)="SECTION 2",XX=XX+1,^TMP(ZZ,$J,J,XX)="",XX=XX+1
|
||
|
|
...S ^TMP(ZZ,$J,J,XX)="The following prescriptions may have been discontinued manually:",XX=XX+1,^TMP(ZZ,$J,J,XX)="",XX=XX+1
|
||
|
|
..S L=0 F S L=$O(^XTMP(TY,JN,2,J,K,L)) Q:'L D
|
||
|
|
...S ^TMP(ZZ,$J,J,XX)=""
|
||
|
|
...S II=0 F S II=$O(^XTMP(TY,JN,2,J,K,L,II)) Q:'II D
|
||
|
|
....S QQ=^XTMP(TY,JN,2,J,K,L,II)
|
||
|
|
....I $D(^TMP(ZZ,$J,J,XX)) S ^TMP(ZZ,$J,J,XX)=$E($P(QQ,"^")_S1,1,35)_$E($P(QQ,"^",2)_S2,1,12)_$S(K="ZZZ":"",1:$E($P(QQ,"^",3),1,32)),XX=XX+1
|
||
|
|
....E S ^TMP(ZZ,$J,J,XX)=S1_$E($P(QQ,"^",2)_S2,1,12)_$S(K="ZZZ":"",1:$E($P(QQ,"^",3),1,32)),XX=XX+1
|
||
|
|
.D:'$D(^XTMP(TY,JN,2,J,"ZZZ"))
|
||
|
|
..S ^TMP(ZZ,$J,J,XX)="",XX=XX+1,^TMP(ZZ,$J,J,XX)=UL,XX=XX+1
|
||
|
|
..S ^TMP(ZZ,$J,J,XX)="SECTION 2",XX=XX+1,^TMP(ZZ,$J,J,XX)="",XX=XX+1
|
||
|
|
..S ^TMP(ZZ,$J,J,XX)="There were no entries that were manually discontinued.",XX=XX+1,^TMP(ZZ,$J,J,XX)=""
|
||
|
|
.S XMY(DUZ)="",XMDUZ="Search for possible invalid Prescription status"
|
||
|
|
.S XMSUB="IMPORTANT - "_$G(DIV)_": Prescriptions to be reviewed."
|
||
|
|
.S XMTEXT="^TMP(ZZ,$J,J," D ^XMD K XMY,^TMP(ZZ,$J,J)
|
||
|
|
END K ^XTMP(TY,JN),^TMP(ZZ,$J),XMY,XMDUZ,ZA,ZB,ZC,DFN,CDFN,RX,RB,XY,XX,TY,JN,ZZ,I,J,K,L,NAME,DIV,STA,STAT,X1,X2
|
||
|
|
Q
|