PSONVARP ;BHM/MFR - Non-VA Med Usage Report - Input ; 5/3/10 5:57pm
;;7.0;OUTPATIENT PHARMACY;**132,118,326,355**;13 Feb 97;Build 1
;External reference to ^%DT is supported by DBIA 10003
;External reference to ^%ZTLOAD is supported by DBIA 10063
;External reference to ^%ZIS is supported by DBIA 10086
;External reference to ^DIR is supported by DBIA 10026
;External reference to ^XLFSTR is supported by DBIA 10104
;
HID ; - Entrhy point from the Hidden Action in the Medication Profile
N PSOHDFLG S PSOHDFLG=1
;
EN N PSOSD,PSOED,PSOST,PSOSRT,PSOAPT,PSOAOI,PSOST,PSOOC,PSOAPT,PSOAOI,I,Y
N OK,X,C,%DT
;
; - Ask for FROM DATE DOCUMENTED
S %DT(0)=-DT,%DT="AEP",%DT("A")="FROM DATE DOCUMENTED: "
W ! D ^%DT I Y<0!($D(DTOUT)) G END
S PSOSD=Y\1-.00001
;
ENDT ; - Ask for TO DATE DOCUMENTED
S %DT(0)=PSOSD+1\1,%DT("A")="TO DATE DOCUMENTED: "
W ! D ^%DT I Y<0!($D(DTOUT)) G END
S PSOED=Y\1+.99999
;
; - Reported called from a Hidden Action menu
I $G(PSOHDFLG) D G DEV
. S:'$G(DFN) DFN=PSODFN
. S PSOPT(DFN)="",PSOAPT=0,PSOAOI=1,PSOST="B",PSOOC="B",PSOSRT="4,2"
;
SORT ; - Ask for SORT BY
K DIR S DIR("B")="PATIENT NAME" D HL1("A")
SORT1 S PSOSRT="",(PSOAPT,PSOAOI)=1,(PSOST,PSOOC)="B"
S DIR("A")="SORT BY",DIR(0)="FO" D HL1("?")
W ! D ^DIR K DIR I $D(DIRUT) G END
;
S OK=1,C=15 W !
F I=1:1:$L(Y,",") D
. S X=$P(Y,",",I) S:X'?.N X=$$TRNS(X) I PSOSRT[X Q
. W !?(C-10),$S(I=1:"SORT BY ",1:"THEN BY ") S C=C+5
. I X<1!(X>5) W X,"???",$C(7) S OK=0 Q
. W $P("PATIENT NAME^ORDERABLE ITEM^DATE DOCUMENTED^STATUS^ORDER CHECKS","^",X)
. S PSOSRT=PSOSRT_","_X
I 'OK S DIR("B")=Y G SORT1
S $E(PSOSRT)=""
;
S OK=1
F I=1:1:$L(PSOSRT,",") D I 'OK Q
. S X=$P(PSOSRT,",",I) D:X'=3 @("SRT"_X)
I 'OK S DIR("B")="PATIENT NAME" G SORT1
;
DEV W ! K %ZIS,IOP,POP,ZTSK S %ZIS="QM" D ^%ZIS K %ZIS I POP G END
I $D(IO("Q")) D G END
. N G K IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK
. S ZTRTN="EN^PSONVAR1",ZTDESC="Non-VA Meds Usage Report"
. F G="PSOSD","PSOED","PSOSRT","PSOPT","PSOOI" S:$D(@G) ZTSAVE(G)=""
. F G="PSOST","PSOOC","PSOAPT","PSOAOI" S:$D(@G) ZTSAVE(G)=""
. S:$D(PSOPT) ZTSAVE("PSOPT(")="" S:$D(PSOOI) ZTSAVE("PSOOI(")=""
. D ^%ZTLOAD W:$D(ZTSK) !,"Report is Queued to print !!" K ZTSK
;
G EN^PSONVAR1
;
END Q
;
SRT1 ; - Selection of PATIENTS to print on the Report
N DIC,X,I K PSOPT S PSOAPT=0
W !!,?5,"You may select a single or multiple PATIENTS,"
W !,?5,"or enter ^ALL to select all PATIENTS.",!
S DIC(0)="QEAM",DIC("A")=" PATIENT: "
F D EN^PSOPATLK S Y=PSOPTLK Q:+Y<1 S:'$$DEAD(+Y,1) PSOPT(+Y)="" K DIC("B"),PSOPTLK
I Y="^ALL" S PSOAPT=1 K PSOPT,DUOUT Q
I $D(DUOUT)!($D(DTOUT)) S OK=0 Q
I '$D(PSOPT),Y<1 S OK=0 Q
Q
;
SRT2 ; - Selection of ORDERABLE ITEMS to print on the Report
N DIC,X,I K PSOOI S PSOAOI=0
W !!,?5,"You may select a single or multiple ORDERABLE ITEMS,"
W !,?5,"or enter ^ALL to select all ORDERABLE ITEMS.",!
S DIC=50.7,DIC(0)="QEAM",DIC("A")=" ORDERABLE ITEM: "
F D ^DIC Q:Y<0 S PSOOI(+Y)="" K DIC("B")
I X="^ALL" S PSOAOI=1 K PSOOI,DUOUT Q
I $D(DUOUT)!($D(DTOUT)) S OK=0 Q
I '$D(PSOOI)&(Y<0) S OK=0 Q
Q
;
SRT4 ; - Selection of STATUS to print on the Report
N DIR,X,I K PSOST
W !!,?5,"You may select (A)CTIVE, (D)ISCONTINUED or (B)OTH status.",!
S DIR(0)="SAO^A:ACTIVE;D:DISCONTINUED;B:BOTH"
S DIR("A")=" STATUS: ",DIR("B")="ACTIVE" D ^DIR
I $D(DIRUT) S OK=0 Q
S PSOST=Y
Q
;
SRT5 ; - Selection of ORDER CHECKS to print on the Report
N DIR,X,OP1,OP2 K PSOOC
S OP1="ORDERS WITH ORDER CHECKS ONLY"
S OP2="ORDERS WITHOUT ORDER CHECKS ONLY"
W !!,?5,"You may select 'Y' to print ",OP1,","
W !?5,"'N' to print ",OP2," or 'B' for BOTH.",!
S DIR(0)="SAO^Y:"_OP1_";N:"_OP2_";B:BOTH"
S DIR("A")=" ORDER CHECKS: ",DIR("B")="BOTH" D ^DIR
I $D(DIRUT) S OK=0 Q
S PSOOC=Y
Q
;
TRNS(X) ; - Translates Alpha into the corresponding Sorting Code
N L,UPX S L=$L(X),UPX=$$UP^XLFSTR(X)
I $E("PATIENT NAME",1,L)=UPX Q 1
I $E("ORDERABLE ITEM",1,L)=UPX Q 2
I $E("DATE DOCUMENTED",1,L)=UPX Q 3
I $E("STATUS",1,L)=UPX Q 4
I $E("ORDER CHECKS",1,L)=UPX Q 5
Q X
;
DEAD(DFN,DSPL) ; Check if Patient has a Date Of Death on File
N VADM,Y
I '$G(DFN) Q 0
D DEM^VADPT I $G(VADM(6))="" Q 0
I $G(DSPL) W !?10,$P($G(VADM(1)),"^")," (",$P($G(VADM(2)),"^",2),") DIED ",$P($G(VADM(6)),"^",2),$C(7)
Q 1
;
HL1(S) ; - Help for the SORT BY prompt
S DIR(S,1)=" Enter the SORT field(s) for this Report:"
S DIR(S,2)=" "
S DIR(S,3)=" 1 - PATIENT NAME"
S DIR(S,4)=" 2 - ORDERABLE ITEM"
S DIR(S,5)=" 3 - DATE DOCUMENTED"
S DIR(S,6)=" 4 - STATUS"
S DIR(S,7)=" 5 - ORDER CHECKS"
S DIR(S,8)=" "
S DIR(S,9)=" Or any combination of the above, separated by comma,"
S DIR(S,10)=" as in these examples:"
S DIR(S,11)=" "
S DIR(S,12)=" 2,1 - BY ORDERABLE ITEM, THEN BY PATIENT NAME"
S DIR(S,13)=" 5,1,4 - BY ORDER CHECKS, THEN BY PATIENT NAME, THEN BY STATUS"
S DIR(S,14)=" "
S DIR(S)=" "
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSONVARP 5057 printed Apr 09, 2024@21:39:11 Page 2
PSONVARP ;BHM/MFR - Non-VA Med Usage Report - Input ; 5/3/10 5:57pm
+1 ;;7.0;OUTPATIENT PHARMACY;**132,118,326,355**;13 Feb 97;Build 1
+2 ;External reference to ^%DT is supported by DBIA 10003
+3 ;External reference to ^%ZTLOAD is supported by DBIA 10063
+4 ;External reference to ^%ZIS is supported by DBIA 10086
+5 ;External reference to ^DIR is supported by DBIA 10026
+6 ;External reference to ^XLFSTR is supported by DBIA 10104
+7 ;
HID ; - Entrhy point from the Hidden Action in the Medication Profile
+1 NEW PSOHDFLG
SET PSOHDFLG=1
+2 ;
EN NEW PSOSD,PSOED,PSOST,PSOSRT,PSOAPT,PSOAOI,PSOST,PSOOC,PSOAPT,PSOAOI,I,Y
+1 NEW OK,X,C,%DT
+2 ;
+3 ; - Ask for FROM DATE DOCUMENTED
+4 SET %DT(0)=-DT
SET %DT="AEP"
SET %DT("A")="FROM DATE DOCUMENTED: "
+5 WRITE !
DO ^%DT
IF Y<0!($DATA(DTOUT))
GOTO END
+6 SET PSOSD=Y\1-.00001
+7 ;
ENDT ; - Ask for TO DATE DOCUMENTED
+1 SET %DT(0)=PSOSD+1\1
SET %DT("A")="TO DATE DOCUMENTED: "
+2 WRITE !
DO ^%DT
IF Y<0!($DATA(DTOUT))
GOTO END
+3 SET PSOED=Y\1+.99999
+4 ;
+5 ; - Reported called from a Hidden Action menu
+6 IF $GET(PSOHDFLG)
Begin DoDot:1
+7 if '$GET(DFN)
SET DFN=PSODFN
+8 SET PSOPT(DFN)=""
SET PSOAPT=0
SET PSOAOI=1
SET PSOST="B"
SET PSOOC="B"
SET PSOSRT="4,2"
End DoDot:1
GOTO DEV
+9 ;
SORT ; - Ask for SORT BY
+1 KILL DIR
SET DIR("B")="PATIENT NAME"
DO HL1("A")
SORT1 SET PSOSRT=""
SET (PSOAPT,PSOAOI)=1
SET (PSOST,PSOOC)="B"
+1 SET DIR("A")="SORT BY"
SET DIR(0)="FO"
DO HL1("?")
+2 WRITE !
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
GOTO END
+3 ;
+4 SET OK=1
SET C=15
WRITE !
+5 FOR I=1:1:$LENGTH(Y,",")
Begin DoDot:1
+6 SET X=$PIECE(Y,",",I)
if X'?.N
SET X=$$TRNS(X)
IF PSOSRT[X
QUIT
+7 WRITE !?(C-10),$SELECT(I=1:"SORT BY ",1:"THEN BY ")
SET C=C+5
+8 IF X<1!(X>5)
WRITE X,"???",$CHAR(7)
SET OK=0
QUIT
+9 WRITE $PIECE("PATIENT NAME^ORDERABLE ITEM^DATE DOCUMENTED^STATUS^ORDER CHECKS","^",X)
+10 SET PSOSRT=PSOSRT_","_X
End DoDot:1
+11 IF 'OK
SET DIR("B")=Y
GOTO SORT1
+12 SET $EXTRACT(PSOSRT)=""
+13 ;
+14 SET OK=1
+15 FOR I=1:1:$LENGTH(PSOSRT,",")
Begin DoDot:1
+16 SET X=$PIECE(PSOSRT,",",I)
if X'=3
DO @("SRT"_X)
End DoDot:1
IF 'OK
QUIT
+17 IF 'OK
SET DIR("B")="PATIENT NAME"
GOTO SORT1
+18 ;
DEV WRITE !
KILL %ZIS,IOP,POP,ZTSK
SET %ZIS="QM"
DO ^%ZIS
KILL %ZIS
IF POP
GOTO END
+1 IF $DATA(IO("Q"))
Begin DoDot:1
+2 NEW G
KILL IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK
+3 SET ZTRTN="EN^PSONVAR1"
SET ZTDESC="Non-VA Meds Usage Report"
+4 FOR G="PSOSD","PSOED","PSOSRT","PSOPT","PSOOI"
if $DATA(@G)
SET ZTSAVE(G)=""
+5 FOR G="PSOST","PSOOC","PSOAPT","PSOAOI"
if $DATA(@G)
SET ZTSAVE(G)=""
+6 if $DATA(PSOPT)
SET ZTSAVE("PSOPT(")=""
if $DATA(PSOOI)
SET ZTSAVE("PSOOI(")=""
+7 DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"Report is Queued to print !!"
KILL ZTSK
End DoDot:1
GOTO END
+8 ;
+9 GOTO EN^PSONVAR1
+10 ;
END QUIT
+1 ;
SRT1 ; - Selection of PATIENTS to print on the Report
+1 NEW DIC,X,I
KILL PSOPT
SET PSOAPT=0
+2 WRITE !!,?5,"You may select a single or multiple PATIENTS,"
+3 WRITE !,?5,"or enter ^ALL to select all PATIENTS.",!
+4 SET DIC(0)="QEAM"
SET DIC("A")=" PATIENT: "
+5 FOR
DO EN^PSOPATLK
SET Y=PSOPTLK
if +Y<1
QUIT
if '$$DEAD(+Y,1)
SET PSOPT(+Y)=""
KILL DIC("B"),PSOPTLK
+6 IF Y="^ALL"
SET PSOAPT=1
KILL PSOPT,DUOUT
QUIT
+7 IF $DATA(DUOUT)!($DATA(DTOUT))
SET OK=0
QUIT
+8 IF '$DATA(PSOPT)
IF Y<1
SET OK=0
QUIT
+9 QUIT
+10 ;
SRT2 ; - Selection of ORDERABLE ITEMS to print on the Report
+1 NEW DIC,X,I
KILL PSOOI
SET PSOAOI=0
+2 WRITE !!,?5,"You may select a single or multiple ORDERABLE ITEMS,"
+3 WRITE !,?5,"or enter ^ALL to select all ORDERABLE ITEMS.",!
+4 SET DIC=50.7
SET DIC(0)="QEAM"
SET DIC("A")=" ORDERABLE ITEM: "
+5 FOR
DO ^DIC
if Y<0
QUIT
SET PSOOI(+Y)=""
KILL DIC("B")
+6 IF X="^ALL"
SET PSOAOI=1
KILL PSOOI,DUOUT
QUIT
+7 IF $DATA(DUOUT)!($DATA(DTOUT))
SET OK=0
QUIT
+8 IF '$DATA(PSOOI)&(Y<0)
SET OK=0
QUIT
+9 QUIT
+10 ;
SRT4 ; - Selection of STATUS to print on the Report
+1 NEW DIR,X,I
KILL PSOST
+2 WRITE !!,?5,"You may select (A)CTIVE, (D)ISCONTINUED or (B)OTH status.",!
+3 SET DIR(0)="SAO^A:ACTIVE;D:DISCONTINUED;B:BOTH"
+4 SET DIR("A")=" STATUS: "
SET DIR("B")="ACTIVE"
DO ^DIR
+5 IF $DATA(DIRUT)
SET OK=0
QUIT
+6 SET PSOST=Y
+7 QUIT
+8 ;
SRT5 ; - Selection of ORDER CHECKS to print on the Report
+1 NEW DIR,X,OP1,OP2
KILL PSOOC
+2 SET OP1="ORDERS WITH ORDER CHECKS ONLY"
+3 SET OP2="ORDERS WITHOUT ORDER CHECKS ONLY"
+4 WRITE !!,?5,"You may select 'Y' to print ",OP1,","
+5 WRITE !?5,"'N' to print ",OP2," or 'B' for BOTH.",!
+6 SET DIR(0)="SAO^Y:"_OP1_";N:"_OP2_";B:BOTH"
+7 SET DIR("A")=" ORDER CHECKS: "
SET DIR("B")="BOTH"
DO ^DIR
+8 IF $DATA(DIRUT)
SET OK=0
QUIT
+9 SET PSOOC=Y
+10 QUIT
+11 ;
TRNS(X) ; - Translates Alpha into the corresponding Sorting Code
+1 NEW L,UPX
SET L=$LENGTH(X)
SET UPX=$$UP^XLFSTR(X)
+2 IF $EXTRACT("PATIENT NAME",1,L)=UPX
QUIT 1
+3 IF $EXTRACT("ORDERABLE ITEM",1,L)=UPX
QUIT 2
+4 IF $EXTRACT("DATE DOCUMENTED",1,L)=UPX
QUIT 3
+5 IF $EXTRACT("STATUS",1,L)=UPX
QUIT 4
+6 IF $EXTRACT("ORDER CHECKS",1,L)=UPX
QUIT 5
+7 QUIT X
+8 ;
DEAD(DFN,DSPL) ; Check if Patient has a Date Of Death on File
+1 NEW VADM,Y
+2 IF '$GET(DFN)
QUIT 0
+3 DO DEM^VADPT
IF $GET(VADM(6))=""
QUIT 0
+4 IF $GET(DSPL)
WRITE !?10,$PIECE($GET(VADM(1)),"^")," (",$PIECE($GET(VADM(2)),"^",2),") DIED ",$PIECE($GET(VADM(6)),"^",2),$CHAR(7)
+5 QUIT 1
+6 ;
HL1(S) ; - Help for the SORT BY prompt
+1 SET DIR(S,1)=" Enter the SORT field(s) for this Report:"
+2 SET DIR(S,2)=" "
+3 SET DIR(S,3)=" 1 - PATIENT NAME"
+4 SET DIR(S,4)=" 2 - ORDERABLE ITEM"
+5 SET DIR(S,5)=" 3 - DATE DOCUMENTED"
+6 SET DIR(S,6)=" 4 - STATUS"
+7 SET DIR(S,7)=" 5 - ORDER CHECKS"
+8 SET DIR(S,8)=" "
+9 SET DIR(S,9)=" Or any combination of the above, separated by comma,"
+10 SET DIR(S,10)=" as in these examples:"
+11 SET DIR(S,11)=" "
+12 SET DIR(S,12)=" 2,1 - BY ORDERABLE ITEM, THEN BY PATIENT NAME"
+13 SET DIR(S,13)=" 5,1,4 - BY ORDER CHECKS, THEN BY PATIENT NAME, THEN BY STATUS"
+14 SET DIR(S,14)=" "
+15 SET DIR(S)=" "
+16 QUIT
