Routine: PSXCSUTL

PSXCSUTL ;BIR/JMB-Utilities for Cost Routines ;[ 04/09/98  9:41 AM ]

 ;;2.0;CMOP;**11,16,38**;11 Apr 97

 ;reference to ^PSDRUG( supported by DBIA #1983

NAME ;Gets drug name by looking up drug ID #

 K PSXNAM S PSXI=$O(^PSDRUG("AQ1",PSXDGID,0))

 S:PSXI PSXNAM=$P($G(^PSDRUG(PSXI,0)),"^")

 S:'PSXI PSXNAM="UNKNOWN" K PSXI

MN ;Gets month & yr

 S PSXRPT="MN"

 S %DT("A")="Enter Month/Year: ",%DT="AQEP" D ^%DT I "^"[X S PSXOUT=1 Q

 G:Y'>0 MN S PSXBDT=$E(Y,1,5)_"00",PSXEDT=$E(Y,1,5)_$P("31^29^31^30^31^30^31^31^30^31^30^31^","^",$E(Y,4,5))

 S PSXFND=$O(^PSX(552.5,"AD",PSXBDT-1))

 D:PSXFND>PSXEDT!(+PSXFND=0) NODATA Q:$G(PSXOUT)  ;Determine if no data for date range

IDYN K PSXEDATE,PSXSDATE W ! S DIR("A")="Do you want to look at data concerning a specific drug",DIR("B")="Y",DIR(0)="Y" D ^DIR K DIR I $G(DIRUT) S PSXOUT=1 Q

 I 'Y G:$G(PSXRPT)="MN" FACYN G BEG

ID S DIC="^PSDRUG(",DIC(0)="AEQMZ" S DIC("S")="I $P($G(^(""ND"")),U,10)]"""""

 D ^DIC K DIC I $D(DTOUT)!$D(DUOUT) S PSXOUT=1 Q

 G:X="" IDYN S PSXID=$P($G(^PSDRUG(+Y,"ND")),"^",10),PSXIDG=+Y

 K X,Y

 G:$G(PSXRPT)="MN" FACYN

BEG W ! S %DT("A")="Beginning Date: ",%DT="AEP" D ^%DT I X["^" S PSXOUT=1 Q

 G:Y<0 BEG S (%DT(0),PSXBDT)=Y

 I Y>DT W !!,"Future dates are not allowed!",! K %DT G BEG

EN W ! S %DT("A")="Ending Date: " D ^%DT I X["^" S PSXOUT=1 Q

 G:Y<0 EN S PSXEDT=Y

 S PSXFND=$O(^PSX(552.5,"AD",PSXBDT-1))

 D:PSXFND>PSXEDT!(+PSXFND=0) NODATA Q:$G(PSXOUT)  ;Determine if no data for date range

FACYN ;Gets facility

 K ^UTILITY("DIQ1",$J)

 W ! S DIR("A")="Print data for a specific facility",DIR("B")="Y",DIR(0)="Y" D ^DIR K DIR I $G(DIRUT) S PSXOUT=1 Q

FAC K PSXEDATE,PSXSDATE Q:'Y  S DIC(0)="AEQMZ",DIC="^DIC(4,",DIC("A")="Select FACILITY: " D ^DIC K DIC G:$G(DTOUT)!($G(DUOUT)) END

 G:Y<0 FAC S XSITE=X,DA=+Y K Y

 S DIC=4,DIQ(0)="I",DR="99" D EN^DIQ1

 S PSXFAC=$G(^UTILITY("DIQ1",$J,4,DA,99,"I"))

 I 'PSXFAC S DA(1)=DA,DA=1,IENS=DA_","_DA(1),PSXFAC=$$GET1^DIQ(4.9999,IENS,.02) I +PSXFAC S PSXFAC=1_PSXFAC ;****DOD L1

 I '$D(^PSX(552.5,PSXFAC,0)) W !,"There is no data for "_XSITE G FACYN

 W ! S DIR("A")="Print data for a specific division",DIR("B")="Y",DIR(0)="Y" D ^DIR K DIR I $G(DIRUT) S PSXOUT=1 Q

DV Q:'Y  S DIC(0)="AEQM",DIC="^PSX(552.5,"_PSXFAC_",1,",DIC("A")="Select DIVISION: " D ^DIC K DIC I $G(DTOUT)!($G(DUOUT)) S PSXOUT=1 Q

 G:Y<0 DV S PSXIENDV=+Y,PSXDV=$P(Y,"^",2)

NODATA ;No data in file

 S Y=PSXBDT X ^DD("DD") S PSXSDATE=Y,Y=PSXEDT X ^DD("DD") S PSXEDATE=Y W !!?4,"** There is no CMOP cost data between "_PSXSDATE_" and "_PSXEDATE_". **"

 W !!?4,"Use the Date Range Compile/Recompile Cost Data option to compile the",!?4,"cost data for this date range." S PSXOUT=1 K PSXEDATE,PSXFND,PSXSDATE

END K ^TMP($J),%,%DT,%H,%T,%Y,%ZIS,DA,DIC,DIE,DIK,DINUM,DIR,DIRUT,DLAYGO,DR

 K DTOUT,DUOUT,POP,PSX50,PSXAVCST,PSXAVG,PSXBDT,PSXBDTE,PSXBDTH,PSXBDTR

 K PSXBEG,PSXBMN,PSXBY,PSXBYR,PSXCDT,PSXCID,PSXCMN,PSXCNT,PSXCNTO

 K PSXCNTDV,PSXCNTR,PSXCOM,PSXCOST,PSXCST,PSXCUT,PSXCYR,PSXDG,PSXDGID

 K PSXDIV,PSXDLN,PSXDT90,PSXDT90R,PSXDR0,PSXDRCST,PSXDT,PSXDV,PSXDVCNT

 K PSXEDT,PSXEDTE,PSXEDTR,PSXEND,PSXEMN,PSXERR,PSXEXIT,PSXEYR,PSXFAC

 K PSXFACN,PSXFACR,PSXFACYN,PSXFCID,PSXFL,PSXFLS,PSXFLD,PSXFND,PSXG

 K PSXID,PSXI,PSXIDG,PSXIDV,PSXIEN,PSXIENDV,PSXJOB,PSXJOBE,PSXLAYGO

 K PSXLGN,PSXLOC,PSXMAX,PSXMC,PSXMCDT,PSXMN,PSXMON,PSXNAM,PSXNEXT

 K PSXNODE,PSXOUT,PSXPC,PSXPDT,PSXPG,PSXPSDT,PSXQTY,PSXRF,PSXRPT,PSXRUN

 K PSXRXN,PSXSLN,PSXSPDV,PSXSUB,PSXT,PSXT1,PSXT2,PSXT3,PSXT4,PSXT5,PSXT6

 K PSXTH,PSXTH1,PSXTH2,PSXTH3,PSXTH4,PSXTH5,PSXTH6,PSXTMP,PSXTOT,PSXVAPRT

 K PSXX,PSXYR,X,X1,X2,Y,ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTSK,ZTIO

 S:$D(ZTQUEUED) ZTREQ="@"

 K PSXION,PSXSTA,PSXSTART,^UTILITY("DIQ1",$J) Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXCSUTL   3721     printed  Feb 18, 2025@23:10:20                                                                                                                                                                                                    Page 2

PSXCSUTL  ;BIR/JMB-Utilities for Cost Routines ;[ 04/09/98  9:41 AM ]

 +1       ;;2.0;CMOP;**11,16,38**;11 Apr 97

 +2       ;reference to ^PSDRUG( supported by DBIA #1983

NAME      ;Gets drug name by looking up drug ID #

 +1        KILL PSXNAM

           SET PSXI=$ORDER(^PSDRUG("AQ1",PSXDGID,0))

 +2        if PSXI

               SET PSXNAM=$PIECE($GET(^PSDRUG(PSXI,0)),"^")

 +3        if 'PSXI

               SET PSXNAM="UNKNOWN"

           KILL PSXI

 +4        QUIT

MN        ;Gets month & yr

 +1        SET PSXRPT="MN"

 +2        SET %DT("A")="Enter Month/Year: "

           SET %DT="AQEP"

           DO ^%DT

           IF "^"[X

               SET PSXOUT=1

               QUIT

 +3        if Y'>0

               GOTO MN

           SET PSXBDT=$EXTRACT(Y,1,5)_"00"

           SET PSXEDT=$EXTRACT(Y,1,5)_$PIECE("31^29^31^30^31^30^31^31^30^31^30^31^","^",$EXTRACT(Y,4,5))

 +4        SET PSXFND=$ORDER(^PSX(552.5,"AD",PSXBDT-1))

 +5       ;Determine if no data for date range

           if PSXFND>PSXEDT!(+PSXFND=0)

               DO NODATA

           if $GET(PSXOUT)

               QUIT

IDYN       KILL PSXEDATE,PSXSDATE

           WRITE !

           SET DIR("A")="Do you want to look at data concerning a specific drug"

           SET DIR("B")="Y"

           SET DIR(0)="Y"

           DO ^DIR

           KILL DIR

           IF $GET(DIRUT)

               SET PSXOUT=1

               QUIT

 +1        IF 'Y

               if $GET(PSXRPT)="MN"

                   GOTO FACYN

               GOTO BEG

ID         SET DIC="^PSDRUG("

           SET DIC(0)="AEQMZ"

           SET DIC("S")="I $P($G(^(""ND"")),U,10)]"""""

 +1        DO ^DIC

           KILL DIC

           IF $DATA(DTOUT)!$DATA(DUOUT)

               SET PSXOUT=1

               QUIT

 +2        if X=""

               GOTO IDYN

           SET PSXID=$PIECE($GET(^PSDRUG(+Y,"ND")),"^",10)

           SET PSXIDG=+Y

 +3        KILL X,Y

 +4        if $GET(PSXRPT)="MN"

               GOTO FACYN

BEG        WRITE !

           SET %DT("A")="Beginning Date: "

           SET %DT="AEP"

           DO ^%DT

           IF X["^"

               SET PSXOUT=1

               QUIT

 +1        if Y<0

               GOTO BEG

           SET (%DT(0),PSXBDT)=Y

 +2        IF Y>DT

               WRITE !!,"Future dates are not allowed!",!

               KILL %DT

               GOTO BEG

EN         WRITE !

           SET %DT("A")="Ending Date: "

           DO ^%DT

           IF X["^"

               SET PSXOUT=1

               QUIT

 +1        if Y<0

               GOTO EN

           SET PSXEDT=Y

 +2        SET PSXFND=$ORDER(^PSX(552.5,"AD",PSXBDT-1))

 +3       ;Determine if no data for date range

           if PSXFND>PSXEDT!(+PSXFND=0)

               DO NODATA

           if $GET(PSXOUT)

               QUIT

FACYN     ;Gets facility

 +1        KILL ^UTILITY("DIQ1",$JOB)

 +2        WRITE !

           SET DIR("A")="Print data for a specific facility"

           SET DIR("B")="Y"

           SET DIR(0)="Y"

           DO ^DIR

           KILL DIR

           IF $GET(DIRUT)

               SET PSXOUT=1

               QUIT

FAC        KILL PSXEDATE,PSXSDATE

           if 'Y

               QUIT

           SET DIC(0)="AEQMZ"

           SET DIC="^DIC(4,"

           SET DIC("A")="Select FACILITY: "

           DO ^DIC

           KILL DIC

           if $GET(DTOUT)!($GET(DUOUT))

               GOTO END

 +1        if Y<0

               GOTO FAC

           SET XSITE=X

           SET DA=+Y

           KILL Y

 +2        SET DIC=4

           SET DIQ(0)="I"

           SET DR="99"

           DO EN^DIQ1

 +3        SET PSXFAC=$GET(^UTILITY("DIQ1",$JOB,4,DA,99,"I"))

 +4       ;****DOD L1

           IF 'PSXFAC

               SET DA(1)=DA

               SET DA=1

               SET IENS=DA_","_DA(1)

               SET PSXFAC=$$GET1^DIQ(4.9999,IENS,.02)

               IF +PSXFAC

                   SET PSXFAC=1_PSXFAC

 +5        IF '$DATA(^PSX(552.5,PSXFAC,0))

               WRITE !,"There is no data for "_XSITE

               GOTO FACYN

 +6        WRITE !

           SET DIR("A")="Print data for a specific division"

           SET DIR("B")="Y"

           SET DIR(0)="Y"

           DO ^DIR

           KILL DIR

           IF $GET(DIRUT)

               SET PSXOUT=1

               QUIT

DV         if 'Y

               QUIT

           SET DIC(0)="AEQM"

           SET DIC="^PSX(552.5,"_PSXFAC_",1,"

           SET DIC("A")="Select DIVISION: "

           DO ^DIC

           KILL DIC

           IF $GET(DTOUT)!($GET(DUOUT))

               SET PSXOUT=1

               QUIT

 +1        if Y<0

               GOTO DV

           SET PSXIENDV=+Y

           SET PSXDV=$PIECE(Y,"^",2)

 +2        QUIT

NODATA    ;No data in file

 +1        SET Y=PSXBDT

           XECUTE ^DD("DD")

           SET PSXSDATE=Y

           SET Y=PSXEDT

           XECUTE ^DD("DD")

           SET PSXEDATE=Y

           WRITE !!?4,"** There is no CMOP cost data between "_PSXSDATE_" and "_PSXEDATE_". **"

 +2        WRITE !!?4,"Use the Date Range Compile/Recompile Cost Data option to compile the",!?4,"cost data for this date range."

           SET PSXOUT=1

           KILL PSXEDATE,PSXFND,PSXSDATE

 +3        QUIT

END        KILL ^TMP($JOB),%,%DT,%H,%T,%Y,%ZIS,DA,DIC,DIE,DIK,DINUM,DIR,DIRUT,DLAYGO,DR

 +1        KILL DTOUT,DUOUT,POP,PSX50,PSXAVCST,PSXAVG,PSXBDT,PSXBDTE,PSXBDTH,PSXBDTR

 +2        KILL PSXBEG,PSXBMN,PSXBY,PSXBYR,PSXCDT,PSXCID,PSXCMN,PSXCNT,PSXCNTO

 +3        KILL PSXCNTDV,PSXCNTR,PSXCOM,PSXCOST,PSXCST,PSXCUT,PSXCYR,PSXDG,PSXDGID

 +4        KILL PSXDIV,PSXDLN,PSXDT90,PSXDT90R,PSXDR0,PSXDRCST,PSXDT,PSXDV,PSXDVCNT

 +5        KILL PSXEDT,PSXEDTE,PSXEDTR,PSXEND,PSXEMN,PSXERR,PSXEXIT,PSXEYR,PSXFAC

 +6        KILL PSXFACN,PSXFACR,PSXFACYN,PSXFCID,PSXFL,PSXFLS,PSXFLD,PSXFND,PSXG

 +7        KILL PSXID,PSXI,PSXIDG,PSXIDV,PSXIEN,PSXIENDV,PSXJOB,PSXJOBE,PSXLAYGO

 +8        KILL PSXLGN,PSXLOC,PSXMAX,PSXMC,PSXMCDT,PSXMN,PSXMON,PSXNAM,PSXNEXT

 +9        KILL PSXNODE,PSXOUT,PSXPC,PSXPDT,PSXPG,PSXPSDT,PSXQTY,PSXRF,PSXRPT,PSXRUN

 +10       KILL PSXRXN,PSXSLN,PSXSPDV,PSXSUB,PSXT,PSXT1,PSXT2,PSXT3,PSXT4,PSXT5,PSXT6

 +11       KILL PSXTH,PSXTH1,PSXTH2,PSXTH3,PSXTH4,PSXTH5,PSXTH6,PSXTMP,PSXTOT,PSXVAPRT

 +12       KILL PSXX,PSXYR,X,X1,X2,Y,ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTSK,ZTIO

 +13       if $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +14       KILL PSXION,PSXSTA,PSXSTART,^UTILITY("DIQ1",$JOB)

           QUIT

PSXCSUTL.m