170 lines
6.8 KiB
Mathematica
170 lines
6.8 KiB
Mathematica
PSONVAR1 ;BHM/MFR - Non-VA Med Usage Report ;04/10/03
|
|
;;7.0;OUTPATIENT PHARMACY;**132,118**;13 Feb 97
|
|
;External reference to File ^PS(55 supported by DBIA 2228
|
|
;External reference to $$GET1^DIQ is supported by DBIA 2056
|
|
;External reference to ^VADPT is supported by DBIA 10061
|
|
;External reference to ^XLFDT is supported by DBIA 10103
|
|
;External reference to ^%ZISC is supported by DBIA 10089
|
|
;
|
|
EN N DATE,DFN,ORD,PAG,PCNT,PRTD,OINAM,PNAM,I,J,Y,X,C,XX,S1,S2,S3,S4,S5,OCNT
|
|
N OCK,OK,STS,SUB,SP1,SP2,SPF
|
|
;
|
|
U IO K ^TMP("PSONV",$J),^TMP("PSOCNT",$J)
|
|
S SPF=0,(SP1,SP2)="",$P(SP1,"=",80)="",$P(SP2,"-",80)=""
|
|
;
|
|
; - Loop through the Non-VA Med orders x-reference
|
|
S DATE=PSOSD,(DFN,ORD)="",(PCNT,OCNT,PRTD)=0 K DIRUT
|
|
DATE S DATE=$O(^PS(55,"ADCDT",DATE)) G NEXT:DATE=""!(DATE>PSOED)
|
|
W:SPF SP1
|
|
;
|
|
DFN I PSOAPT S DFN=$O(^PS(55,"ADCDT",DATE,DFN)) G DATE:DFN=""
|
|
I 'PSOAPT S DFN=$O(PSOPT(DFN)) G DATE:DFN="" ;Patient Filter
|
|
;
|
|
I $$DEAD^PSONVARP(DFN) G DFN ;Patient is Dead
|
|
;
|
|
ORD S ORD=$O(^PS(55,"ADCDT",DATE,DFN,ORD)) G DFN:ORD=""
|
|
S XX=$G(^PS(55,DFN,"NVA",ORD,0))
|
|
I 'PSOAOI,'$D(PSOOI(+$P(XX,"^"))) G ORD ;OI Filter
|
|
I '$P(XX,"^",6),PSOST="D" G ORD ;Status Filter
|
|
I $P(XX,"^",6),PSOST="A" G ORD
|
|
I '$D(^PS(55,DFN,"NVA",ORD,"OCK")),PSOOC="Y" G ORD ;Order Checks Filter
|
|
I $D(^PS(55,DFN,"NVA",ORD,"OCK")),PSOOC="N" G ORD
|
|
;
|
|
I PSOSRT=3 D G CLOSE:$D(DIRUT),ORD ;If not Sorting,
|
|
. I $Y>(IOSL-9) D HDR I $D(DIRUT) Q ;Print the Report
|
|
. D PRINT(DFN,ORD) Q:$D(DIRUT) S SPF=1 ;Then G ORD
|
|
;
|
|
I PSOSRT[1 S PNAM=$$GET1^DIQ(2,DFN,.01) ;Retrieving Patient
|
|
I PSOSRT[2 S OINAM=$$GET1^DIQ(50.7,+$P(XX,"^"),.01) ;Name and Orderable
|
|
S:$G(PNAM)="" PNAM=0 S:$G(OINAM)="" OINAM=0 ;Item Name
|
|
S (S1,S2,S3,S4,S5)=0
|
|
F I=1:1:$L(PSOSRT,",") D
|
|
. S Y=$P(PSOSRT,",",I),STS=+$P(XX,"^",6)
|
|
. S OCK=$S($D(^PS(55,DFN,"NVA",ORD,"OCK")):1,1:2)
|
|
. S @("S"_I)=$S(Y=1:PNAM,Y=2:OINAM,Y=3:DATE,Y=4:+STS,Y=5:OCK)
|
|
S ^TMP("PSONV",$J,S1,S2,S3,S4,S5,DFN,ORD)=""
|
|
G ORD
|
|
;
|
|
NEXT ; - If not Sorting (already printed), SKIP, otherwise, print the report
|
|
I PSOSRT="" G NDTP
|
|
S (S1,S2,S3,S4,S5,DFN,ORD)=""
|
|
F S S1=$O(^TMP("PSONV",$J,S1)) Q:S1="" D Q:$D(DIRUT)
|
|
. F S S2=$O(^TMP("PSONV",$J,S1,S2)) Q:S2="" D Q:$D(DIRUT)
|
|
. . F S S3=$O(^TMP("PSONV",$J,S1,S2,S3)) Q:S3="" D Q:$D(DIRUT)
|
|
. . . F S S4=$O(^TMP("PSONV",$J,S1,S2,S3,S4)) Q:S4="" D Q:$D(DIRUT)
|
|
. . . . F S S5=$O(^TMP("PSONV",$J,S1,S2,S3,S4,S5)) Q:S5="" D Q:$D(DIRUT)
|
|
. . . . . F S DFN=$O(^TMP("PSONV",$J,S1,S2,S3,S4,S5,DFN)) Q:DFN="" D Q:$D(DIRUT)
|
|
. . . . . . F S ORD=$O(^TMP("PSONV",$J,S1,S2,S3,S4,S5,DFN,ORD)) Q:ORD="" D Q:$D(DIRUT)
|
|
. . . . . . . I $Y>(IOSL-12) D HDR I $D(DIRUT) Q
|
|
. . . . . . . D PRINT(DFN,ORD)
|
|
. . I '$D(DIRUT),S2'=0,$O(^TMP("PSONV",$J,S1,S2))'="" W SP2
|
|
. I '$D(DIRUT),$O(^TMP("PSONV",$J,S1))'="" W SP1
|
|
G CLOSE:$D(DIRUT)
|
|
;
|
|
NDTP I 'PRTD D HDR W !!?18,"********** NO DATA TO PRINT **********"
|
|
I PRTD D
|
|
. W SP1
|
|
. W !,"Total: ",PCNT," patient",$S(PCNT>1:"s",1:"")
|
|
. W " and ",OCNT," order",$S(OCNT>1:"s",1:""),"."
|
|
;
|
|
CLOSE D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
|
END K ^TMP("PSONV",$J),^TMP("PSOCNT",$J)
|
|
Q
|
|
;
|
|
PRINT(DFN,ORD) ; - Print a Non-VA Med Order
|
|
;Input: DFN-Patient;ORD-Non-VA Order#
|
|
N X,XX,K,OI,OIX,OINAM,DGNAM,PNAM,PSSN,CLNAM,PRV,I,J,Z,TXT,VAPA,VADM,SCH
|
|
N STR,OCK
|
|
;
|
|
I '$D(^PS(55,DFN,"NVA",ORD)) Q
|
|
I '$G(PAG) D HDR I $D(DIRUT) Q
|
|
;
|
|
S XX=^PS(55,DFN,"NVA",ORD,0),OINAM=$$GET1^DIQ(50.7,+$P(XX,"^"),.01)
|
|
S DGNAM="" I $P(XX,"^",2) S DGNAM=$$GET1^DIQ(50,+$P(XX,"^",2),.01)
|
|
D DEM^VADPT,ADD^VADPT S PNAM=$P(VADM(1),"^"),PSSN=$P($G(VADM(2)),"^",2)
|
|
W !,PNAM," (ID:",$S(PSSN:$P(PSSN,"-",3),1:"0000"),")"
|
|
W ?46,"Patient Phone #: ",$E($P(VAPA(8),"^"),1,16)
|
|
S:'$D(^TMP("PSOCNT",$J,DFN)) PCNT=PCNT+1 S ^TMP("PSOCNT",$J,DFN)=""
|
|
;
|
|
W !?5,"Non-VA Med: ",OINAM
|
|
W !?2,"Dispense Drug: ",$E(DGNAM,1,37)
|
|
W ?55,"Dosage: ",$E($P(XX,"^",3),1,16)
|
|
W !?7,"Schedule: " S X=$E($P(XX,"^",5),1,30)
|
|
S SCH=$S($L($P(XX,"^",5))>30:$P(X," ",1,$L(X," ")-1),1:X) W SCH
|
|
W ?52,"Med Route: ",$E($P(XX,"^",4),1,35)
|
|
I $E($P(XX,"^",5),$L(SCH)+1,99)'="" D
|
|
. W !?16,$E($P(XX,"^",5),$L(SCH)+1,99)
|
|
W !?9,"Status: ",$S('$P(XX,"^",6):"ACTIVE",1:"DISCONTINUED on "_$$DT($P(XX,"^",7)))
|
|
W ?49,"CPRS Order #: ",$P(XX,"^",8)
|
|
W !?2,"Documented By: ",$E($$GET1^DIQ(200,+$P(XX,"^",11),.01),1,29)
|
|
W ?46,"Documented Date: ",$$DT($P(XX,"^",10))
|
|
S CLNAM=$$GET1^DIQ(44,+$P(XX,"^",12),.01)
|
|
W !?9,"Clinic: " W:$P(XX,"^",12) $E($P(XX,"^",12)_" - "_CLNAM,1,33)
|
|
W ?51,"Start Date: ",$$DT($P(XX,"^",9)),!
|
|
;
|
|
; - Printing "Order Checks" fields
|
|
W:$D(^PS(55,DFN,"NVA",ORD,"OCK")) !
|
|
F I=0:0 S I=$O(^PS(55,DFN,"NVA",ORD,"OCK",I)) Q:'I D Q:$D(DIRUT)
|
|
. S OCK=^PS(55,DFN,"NVA",ORD,"OCK",I,0),STR=$P(OCK,"^"),PRV=+$P(OCK,"^",2)
|
|
. I $Y>(IOSL-5) D HDR Q:$D(DIRUT) W !
|
|
. W ?1,"Order Check #",I,": " K TXT D TEXT(.TXT,STR,61)
|
|
. F K=1:1 Q:'$D(TXT(K)) D Q:$D(DIRUT)
|
|
. . W ?17,TXT(K),! I $Y>(IOSL-4) D HDR Q:$D(DIRUT) W !
|
|
. Q:$D(DIRUT) K TXT
|
|
. F J=0:0 S J=$O(^PS(55,DFN,"NVA",ORD,"OCK",I,"OVR",J)) Q:'J D
|
|
. . S STR=^PS(55,DFN,"NVA",ORD,"OCK",I,"OVR",J,0)
|
|
. . D TEXT(.TXT,STR,56)
|
|
. W ?6,"Override Reason: " W:'$D(TXT) !
|
|
. F K=1:1 Q:'$D(TXT(K)) D Q:$D(DIRUT)
|
|
. . W ?23,TXT(K),! I $Y>(IOSL-4) D HDR Q:$D(DIRUT) W !
|
|
. Q:$D(DIRUT)
|
|
. W ?6,"Override Provider: " W:PRV $$GET1^DIQ(200,+PRV,.01) W !
|
|
Q:$D(DIRUT)
|
|
;
|
|
; - Printing "Statement/Explanation/Comments" field
|
|
I $D(^PS(55,DFN,"NVA",ORD,"DSC")) D Q:$D(DIRUT)
|
|
. W !,"Statement/Explanation/Comments: " K TXT
|
|
. F I=0:0 S I=$O(^PS(55,DFN,"NVA",ORD,"DSC",I)) Q:'I D
|
|
. . S STR=^PS(55,DFN,"NVA",ORD,"DSC",I,0)
|
|
. . D TEXT(.TXT,STR,47)
|
|
. F K=1:1 Q:'$D(TXT(K)) D Q:$D(DIRUT)
|
|
. . W ?32,TXT(K),! I $Y>(IOSL-4) D HDR Q:$D(DIRUT) W !
|
|
;
|
|
S PRTD=1,OCNT=OCNT+1
|
|
Q
|
|
;
|
|
TEXT(TEXT,STR,L) ; Formats STR into TEXT array, lines lenght = L
|
|
N J,WORD,K S K=+$O(TEXT(""),-1) S:'K K=1
|
|
F J=1:1:$L(STR," ") D
|
|
. S WORD=$P(STR," ",J) I ($L($G(TEXT(K))_WORD))>L S K=K+1
|
|
. S TEXT(K)=$G(TEXT(K))_WORD_" "
|
|
Q
|
|
;
|
|
HDR ; - Prints the Header
|
|
N X,DIR S PAG=$G(PAG)+1
|
|
I PAG>1,$E(IOST)="C" D Q:$D(DIRUT)
|
|
. S DIR(0)="E",DIR("A")=" Press ENTER to Continue or ^ to Exit" D ^DIR
|
|
;
|
|
W @IOF,"Non-VA Meds Usage Report",?74,"Page: ",$J(PAG,3)
|
|
W !,"Sorted by",$$SRT(PSOSRT)
|
|
W !,"Date Range: "_$$DT(PSOSD+1\1)_" - "_$$DT(PSOED\1)
|
|
W ?48,"Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT())
|
|
S X="",$P(X,"-",80)="" W !,X
|
|
Q
|
|
;
|
|
SRT(ST) ; - Convert the "1,2,4" (example) to "PATIENT,ORDERABLE ITEM,STATUS"
|
|
;Input: ST-String with the Sorting fields by number
|
|
;Output: ST-String with the Sorting fields by name
|
|
N I,X,STR,FLD
|
|
S STR="PATIENT NAME^ORDERABLE ITEM^DATE DOCUMENTED^STATUS^ORDER CHECKS"
|
|
F I=1:1:$L(ST,",") D
|
|
. S FLD=+$P(ST,",",I),X=$P(STR,"^",FLD)
|
|
. S $P(ST,",",I)=" "_X
|
|
Q ST
|
|
;
|
|
DT(DT) ; - Convert FM Date to MM/DD/YYYY
|
|
I 'DT Q ""
|
|
I '(DT#10000) Q (1700+$E(DT,1,3))
|
|
I '(DT#100) Q $E(DT,4,5)_"/"_(1700+$E(DT,1,3))
|
|
Q $E(DT,4,5)_"/"_$E(DT,6,7)_"/"_(1700+$E(DT,1,3))
|