PSGEUDD.m

PSGEUDD ;BIR/MV-EXTRA UNITS DISPENSED REPORT ;14 JAN 97 / 9:22 AM

 ;;5.0; INPATIENT MEDICATIONS ;**27,31,59,111**;16 DEC 97

 ;

 ; Reference to ^PS(55 is supported by DBIA# 2191

 ; Reference to ^DIC(42 is supported by DBIA# 10039

 ;

NEW ;***New needed variables.

 K ^TMP($J)

 NEW AMT,DRG,ND,NO,PPN,TM,WHO,XDESC,XSAVE,XTRTN,PSJACNWP

 ;

ASK ;***Ask for date range and output device

 Q:$$STDATE^PSJMDIR  S PSGSDT=Y

 K DIR S DIR(0)="DAO^"_PSGSDT_"::,EXAR",DIR("A")="Enter Ending Date and Time: ",DIR("?")="Please enter a date and time that is greater than the Start Date" D ^DIR S PSGEDT=Y Q:$$STOP^PSJMDIR

 Q:$$GWP^PSJMDIR1(0)

 Q:$$SELDEV^PSJMUTL

 W:'$D(IO("Q")) !,"this may take a while...(you should QUEUE the Extra Units Dispensed report)"

 ;***Queue to sort in the background.

 I $D(IO("Q")) D  G EXIT

 . S XDESC="Extra Unit Dose Dispensed (Sort)"

 . ;Added PSGWGNM to XSAVE to enable printing of ward group total for queued prints

 . S XSAVE="PSGWGNM;PSGSDT;PSGEDT;PSGSS;PSGIO;PSGWG;PSGWD;PSGWN;PSGTMALL;PSGTM;PSGPAT(;PSGP(;PSGIODOC"

 . S XTRTN="START^PSGEUDD"

 . D SETSORTQ^PSJMUTL(XDESC,XSAVE,XTRTN)

 D START

 ;

EXIT ;***Exit report here.

 D ENKV^PSGSETU

 D EXIT^PSJMUTL

 K ^TMP($J),PSGDT,PSGEDT,PSGIO,PSGORD,PSGP,PSGPAT,PSGSDT,PSGSS,PSGTM,PSGTMALL,PSGWD,PSGWG,PSGWGNM,PSGWN,PSJSTOP

 Q

START ;***Start queuing here.

 D @PSGSS

 ;***Queue to the printer.

 I $D(PSGIO) D  G EXIT

 . S XDESC="Extra Unit Dose Dispensed (Print)"

 . S XSAVE="^TMP($J,;PSGWGNM;PSGTMALL;PSGTM;PSGSDT;PSGEDT;PSGSS;PSGIODOC"

 . S XTRTN="^PSGEUDP"

 . D SETPRTQ^PSJMUTL(XDESC,XSAVE,XTRTN)

 D ^PSGEUDP

 Q

 ;

P ;***Select by Patient

 S PPN="" F  S PPN=$O(PSGPAT(PPN)) Q:PPN=""  S PSGP=PSGPAT(PPN),PSJACNWP="" K PSJPPID,PSJPRB D ^PSJAC,LOOP

 Q

 ;

C ;***Select by CLINIC

 N DT,CLIN

 S TM="ZZ",PSJACNWP=""

 S DT=PSGSDT F  S DT=$O(^PS(55,"AUDC",DT)) Q:DT>PSGEDT!(DT="")  S CLIN=0 F  S CLIN=$O(^PS(55,"AUDC",DT,CLIN)) Q:'CLIN  D

 .S PSGP=0 F  S PSGP=$O(^PS(55,"AUDC",DT,CLIN,PSGP)) Q:'PSGP   D ^PSJAC S PPN=PSGP(0) D LOOP

 Q

G ;***Select by WARD GROUP

 D WARDGP

 Q

W ;***Select by Ward

 D WARD

 Q

WARDGP ;*** Find wards within a ward group

 S PSGWD="",TM="ZZ" F  S PSGWD=$O(^PS(57.5,"AC",PSGWG,PSGWD)) Q:'PSGWD  I $D(^DIC(42,+PSGWD,0)) S PSGWN=$P(^(0),U) D WARD

 Q

 ;

WARD ;*** Go through each patient within a given WARD

 ;*** Var used in PSJAC. Set to null to skip WP^PSJAC

 S PSJACNWP=""

 F PSGP=0:0 S PSGP=$O(^DPT("CN",PSGWN,PSGP)) Q:'PSGP  D ^PSJAC S PPN=PSGP(0) D:PSGSS="W" TEAM D:PSGSS="G" LOOP

 Q

TEAM ;*** Look up selected team.  PSGTMALL= All teams were selected.

 S TM=""

 I PSGTMALL D ALLTM,LOOP Q

 I 'PSGTM S TM="ZZ" D LOOP Q

 D ALLTM D:$D(PSGTM(TM)) LOOP

 Q

 ;

ALLTM ;*** Get UNIT DOSE information from ^PS(55

 ;

 S TM="ZZ"

 S TM=$S(PSJPRB="":0,1:+$O(^PS(57.7,"AWRT",PSGWD,PSJPRB,0))),TM=$S('TM:"ZZ",'$D(^PS(57.7,PSGWD,1,TM,0)):TM,$P(^(0),U)]"":$P(^(0),U),1:TM)

 Q

 ;

LOOP ;***Loop thru ^PS(55 on the Dispense log multiple.

 F PSGORD=0:0 S PSGORD=$O(^PS(55,+PSGP,5,PSGORD)) Q:'PSGORD  D

 . S PSGDT=PSGSDT-.000001

 . F  S PSGDT=$O(^PS(55,+PSGP,5,+PSGORD,11,"B",PSGDT)) Q:'PSGDT!(PSGEDT<PSGDT)  D

 ..F NO=0:0  S NO=$O(^PS(55,+PSGP,5,+PSGORD,11,"B",PSGDT,NO)) Q:'NO  S ND=^PS(55,+PSGP,5,+PSGORD,11,NO,0) D

 ...I $P(ND,U,5)=3 S DRG=$$ENDDN^PSGMI($P(ND,U,2)),AMT=$P(ND,U,3),WHO=$P(ND,U,6) D @($S(PSGSS="P":"TMPPT",1:"TMPWG"))

 Q

 ;

TMPWG ;***Set ^TMP global for selected by Ward/Ward Group.

 S ^TMP($J,PSGWN,TM,DRG,$E(PPN,1,10)_"^"_+PSGP,PSGDT)=AMT_U_WHO_U_PSJPBID

 Q

 ;

TMPPT ;***Set ^TMP global for selected by patient.

 S ^TMP($J,$E(PPN,1,10)_"^"_+PSGP,DRG,PSGDT)=AMT_U_WHO_U_PSJPPID_U_PSJPRB_U_PSJPWDN

 Q

PSGEUDD   ;BIR/MV-EXTRA UNITS DISPENSED REPORT ;14 JAN 97 / 9:22 AM

 +1       ;;5.0; INPATIENT MEDICATIONS ;**27,31,59,111**;16 DEC 97

 +2       ;

 +3       ; Reference to ^PS(55 is supported by DBIA# 2191

 +4       ; Reference to ^DIC(42 is supported by DBIA# 10039

 +5       ;

NEW       ;***New needed variables.

 +1        KILL ^TMP($JOB)

 +2        NEW AMT,DRG,ND,NO,PPN,TM,WHO,XDESC,XSAVE,XTRTN,PSJACNWP

 +3       ;

ASK       ;***Ask for date range and output device

 +1        IF $$STDATE^PSJMDIR

               QUIT 

           SET PSGSDT=Y

 +2        KILL DIR

           SET DIR(0)="DAO^"_PSGSDT_"::,EXAR"

           SET DIR("A")="Enter Ending Date and Time: "

           SET DIR("?")="Please enter a date and time that is greater than the Start Date"

           DO ^DIR

           SET PSGEDT=Y

           IF $$STOP^PSJMDIR

               QUIT 

 +3        IF $$GWP^PSJMDIR1(0)

               QUIT 

 +4        IF $$SELDEV^PSJMUTL

               QUIT 

 +5        IF '$DATA(IO("Q"))

               WRITE !,"this may take a while...(you should QUEUE the Extra Units Dispensed report)"

 +6       ;***Queue to sort in the background.

 +7        IF $DATA(IO("Q"))

               Begin DoDot:1

 +8                SET XDESC="Extra Unit Dose Dispensed (Sort)"

 +9       ;Added PSGWGNM to XSAVE to enable printing of ward group total for queued prints

 +10               SET XSAVE="PSGWGNM;PSGSDT;PSGEDT;PSGSS;PSGIO;PSGWG;PSGWD;PSGWN;PSGTMALL;PSGTM;PSGPAT(;PSGP(;PSGIODOC"

 +11               SET XTRTN="START^PSGEUDD"

 +12               DO SETSORTQ^PSJMUTL(XDESC,XSAVE,XTRTN)

               End DoDot:1

               GOTO EXIT

 +13       DO START

 +14      ;

EXIT      ;***Exit report here.

 +1        DO ENKV^PSGSETU

 +2        DO EXIT^PSJMUTL

 +3        KILL ^TMP($JOB),PSGDT,PSGEDT,PSGIO,PSGORD,PSGP,PSGPAT,PSGSDT,PSGSS,PSGTM,PSGTMALL,PSGWD,PSGWG,PSGWGNM,PSGWN,PSJSTOP

 +4        QUIT 

START     ;***Start queuing here.

 +1        DO @PSGSS

 +2       ;***Queue to the printer.

 +3        IF $DATA(PSGIO)

               Begin DoDot:1

 +4                SET XDESC="Extra Unit Dose Dispensed (Print)"

 +5                SET XSAVE="^TMP($J,;PSGWGNM;PSGTMALL;PSGTM;PSGSDT;PSGEDT;PSGSS;PSGIODOC"

 +6                SET XTRTN="^PSGEUDP"

 +7                DO SETPRTQ^PSJMUTL(XDESC,XSAVE,XTRTN)

               End DoDot:1

               GOTO EXIT

 +8        DO ^PSGEUDP

 +9        QUIT 

 +10      ;

P         ;***Select by Patient

 +1        SET PPN=""

           FOR 

               SET PPN=$ORDER(PSGPAT(PPN))

               IF PPN=""

                   QUIT 

               SET PSGP=PSGPAT(PPN)

               SET PSJACNWP=""

               KILL PSJPPID,PSJPRB

               DO ^PSJAC

               DO LOOP

 +2        QUIT 

 +3       ;

C         ;***Select by CLINIC

 +1        NEW DT,CLIN

 +2        SET TM="ZZ"

           SET PSJACNWP=""

 +3        SET DT=PSGSDT

           FOR 

               SET DT=$ORDER(^PS(55,"AUDC",DT))

               IF DT>PSGEDT!(DT="")

                   QUIT 

               SET CLIN=0

               FOR 

                   SET CLIN=$ORDER(^PS(55,"AUDC",DT,CLIN))

                   IF 'CLIN

                       QUIT 

                   Begin DoDot:1

 +4                    SET PSGP=0

                       FOR 

                           SET PSGP=$ORDER(^PS(55,"AUDC",DT,CLIN,PSGP))

                           IF 'PSGP

                               QUIT 

                           DO ^PSJAC

                           SET PPN=PSGP(0)

                           DO LOOP

                   End DoDot:1

 +5        QUIT 

G         ;***Select by WARD GROUP

 +1        DO WARDGP

 +2        QUIT 

W         ;***Select by Ward

 +1        DO WARD

 +2        QUIT 

WARDGP    ;*** Find wards within a ward group

 +1        SET PSGWD=""

           SET TM="ZZ"

           FOR 

               SET PSGWD=$ORDER(^PS(57.5,"AC",PSGWG,PSGWD))

               IF 'PSGWD

                   QUIT 

               IF $DATA(^DIC(42,+PSGWD,0))

                   SET PSGWN=$PIECE(^(0),U)

                   DO WARD

 +2        QUIT 

 +3       ;

WARD      ;*** Go through each patient within a given WARD

 +1       ;*** Var used in PSJAC. Set to null to skip WP^PSJAC

 +2        SET PSJACNWP=""

 +3        FOR PSGP=0:0

               SET PSGP=$ORDER(^DPT("CN",PSGWN,PSGP))

               IF 'PSGP

                   QUIT 

               DO ^PSJAC

               SET PPN=PSGP(0)

               IF PSGSS="W"

                   DO TEAM

               IF PSGSS="G"

                   DO LOOP

 +4        QUIT 

TEAM      ;*** Look up selected team.  PSGTMALL= All teams were selected.

 +1        SET TM=""

 +2        IF PSGTMALL

               DO ALLTM

               DO LOOP

               QUIT 

 +3        IF 'PSGTM

               SET TM="ZZ"

               DO LOOP

               QUIT 

 +4        DO ALLTM

           IF $DATA(PSGTM(TM))

               DO LOOP

 +5        QUIT 

 +6       ;

ALLTM     ;*** Get UNIT DOSE information from ^PS(55

 +1       ;

 +2        SET TM="ZZ"

 +3        SET TM=$SELECT(PSJPRB="":0,1:+$ORDER(^PS(57.7,"AWRT",PSGWD,PSJPRB,0)))

           SET TM=$SELECT('TM:"ZZ",'$DATA(^PS(57.7,PSGWD,1,TM,0)):TM,$PIECE(^(0),U)]"":$PIECE(^(0),U),1:TM)

 +4        QUIT 

 +5       ;

LOOP      ;***Loop thru ^PS(55 on the Dispense log multiple.

 +1        FOR PSGORD=0:0

               SET PSGORD=$ORDER(^PS(55,+PSGP,5,PSGORD))

               IF 'PSGORD

                   QUIT 

               Begin DoDot:1

 +2                SET PSGDT=PSGSDT-.000001

 +3                FOR 

                       SET PSGDT=$ORDER(^PS(55,+PSGP,5,+PSGORD,11,"B",PSGDT))

                       IF 'PSGDT!(PSGEDT<PSGDT)

                           QUIT 

                       Begin DoDot:2

 +4                        FOR NO=0:0

                               SET NO=$ORDER(^PS(55,+PSGP,5,+PSGORD,11,"B",PSGDT,NO))

                               IF 'NO

                                   QUIT 

                               SET ND=^PS(55,+PSGP,5,+PSGORD,11,NO,0)

                               Begin DoDot:3

 +5                                IF $PIECE(ND,U,5)=3

                                       SET DRG=$$ENDDN^PSGMI($PIECE(ND,U,2))

                                       SET AMT=$PIECE(ND,U,3)

                                       SET WHO=$PIECE(ND,U,6)

                                       DO @($SELECT(PSGSS="P":"TMPPT",1:"TMPWG"))

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +6        QUIT 

 +7       ;

TMPWG     ;***Set ^TMP global for selected by Ward/Ward Group.

 +1        SET ^TMP($JOB,PSGWN,TM,DRG,$EXTRACT(PPN,1,10)_"^"_+PSGP,PSGDT)=AMT_U_WHO_U_PSJPBID

 +2        QUIT 

 +3       ;

TMPPT     ;***Set ^TMP global for selected by patient.

 +1        SET ^TMP($JOB,$EXTRACT(PPN,1,10)_"^"_+PSGP,DRG,PSGDT)=AMT_U_WHO_U_PSJPPID_U_PSJPRB_U_PSJPWDN

 +2        QUIT