PSONVARP.m

PSONVARP ;BHM/MFR - Non-VA Med Usage Report - Input ;04/10/03

 ;;7.0;OUTPATIENT PHARMACY;**132,118,326**;13 Feb 97;Build 11

 ;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 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

PSONVARP  ;BHM/MFR - Non-VA Med Usage Report - Input ;04/10/03

 +1       ;;7.0;OUTPATIENT PHARMACY;**132,118,326**;13 Feb 97;Build 11

 +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                SET PSOPT(DFN)=""

                   SET PSOAPT=0

                   SET PSOAOI=1

                   SET PSOST="B"

                   SET PSOOC="B"

                   SET PSOSRT="4,2"

               End DoDot:1

               GOTO DEV

 +8       ;

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