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