PSBOMD.m

PSBOMD ;BIRMINGHAM/EFC-MISSING DOSE REPORT ;Mar 2004

 ;;3.0;BAR CODE MED ADMIN;;Mar 2004

 ;

 ; Reference/IA

 ; WARD^NURSUT5/3052

 ; IN5^VADPT/10061

 ; $$GET1^DIQ(52.6/436

 ; $$GET1^DIQ(52.7/437

 ;

EN ; Begin printing

 N PSBSCHD,PSBWRD,PSBSTRT,PSBSTOP,PSBWARD,PSBDRUG,PSBDT,PSBIEN,PSBWRDA

 K ^TMP("PSB",$J)

 S PSBWRD=+$P(PSBRPT(.1),U,3)

 I PSBWRD D WARD^NURSUT5("L^"_PSBWRD,.PSBWRDA) S X="" F  S X=$O(PSBWRDA(PSBWRD,2,X)) Q:X=""  S Y=PSBWRDA(PSBWRD,2,X,.01),PSBWRD(+Y)=$P(Y,U,2),^TMP("PSB",$J,PSBWRD(+Y))=0

 S PSBSTRT=$P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,7)

 S PSBSTOP=$P(PSBRPT(.1),U,8)+$P(PSBRPT(.1),U,9)

 S PSBDT=PSBSTRT-.0000001

 F  S PSBDT=$O(^PSB(53.68,"ADTE",PSBDT)) Q:'PSBDT!(PSBDT>PSBSTOP)  D

 .S PSBIEN=0

 .F  S PSBIEN=$O(^PSB(53.68,"ADTE",PSBDT,PSBIEN))  Q:'PSBIEN  D

 ..Q:PSBWRD&('$D(PSBWRD(+$P($G(^PSB(53.68,PSBIEN,.1)),U,2))))

 ..S PSBWARD=$$GET1^DIQ(53.68,PSBIEN_",",.12) Q:PSBWARD=""

 ..S PSBDRUG=$$GET1^DIQ(53.68,PSBIEN_",",.13) I PSBDRUG="" D

 ...S PSBDRUG="NO DATA"

 ...I $D(^PSB(53.68,PSBIEN,.6)) S X=0 F  S X=$O(^PSB(53.68,+PSBIEN,.6,X)) Q:'X  S PSBDRUG=$$GET1^DIQ(52.6,+^PSB(53.68,PSBIEN,.6,X,0),.01)

 ...I $D(^PSB(53.68,PSBIEN,.7)) S X=0 F  S X=$O(^PSB(53.68,+PSBIEN,.7,X)) Q:'X  S PSBDRUG=PSBDRUG_"  "_$$GET1^DIQ(52.7,+^PSB(53.68,+PSBIEN,.7,X,0),.01)

 ..S PSBSCHD=$$GET1^DIQ(53.68,PSBIEN_",",.19) S:PSBSCHD="" PSBSCHD="NO DATA"

 ..S ^TMP("PSB",$J,PSBWARD,PSBDRUG,PSBSCHD)=$G(^TMP("PSB",$J,PSBWARD,PSBDRUG,PSBSCHD))+1

 ..S ^TMP("PSB",$J,PSBWARD)=+$G(^TMP("PSB",$J,PSBWARD))+1

 ..S ^TMP("PSB",$J)=+$G(^TMP("PSB",$J))+1

 W $$HDR()

 I '$D(^TMP("PSB",$J)) W !!?5,"<<<NO MISSING DOSE REQUESTS FOR THIS TIME FRAME>>>" Q

 S PSBWARD=""

 F  S PSBWARD=$O(^TMP("PSB",$J,PSBWARD)) Q:PSBWARD=""  D

 .W:$Y>(IOSL-10) $$HDR()

 .W !,PSBWARD

 .S (PSBDRUG,PSBSCHD)=""

 .F  S PSBDRUG=$O(^TMP("PSB",$J,PSBWARD,PSBDRUG)) Q:PSBDRUG=""  D

 ..F  S PSBSCHD=$O(^TMP("PSB",$J,PSBWARD,PSBDRUG,PSBSCHD)) Q:PSBSCHD=""  D

 ...W:$Y>(IOSL-10) $$HDR()

 ...W ?32,PSBDRUG,?74,$J(+^TMP("PSB",$J,PSBWARD,PSBDRUG,PSBSCHD),8),!,?35,"Schedule: "_PSBSCHD,!

 .W ?74,"--------"

 .W !?32,"Ward ",PSBWARD," Total: ",?74,$J(^TMP("PSB",$J,PSBWARD),8),!

 W ?74,"========"

 W !?32,"Report Total: ",?74,$J(+$G(^TMP("PSB",$J)),8)

 K ^TMP("PSB",$J)

 Q

 ;

HDR() ;

 I '$D(PSBRPT("DATE")) D NOW^%DTC S Y=+$E(%,1,12) D D^DIQ S PSBRPT("DATE")="Run Date: "_Y

 S:'$D(PSBRPT("PAGE")) PSBRPT("PAGE")=1

 W:$Y>1 @IOF

 W !,$TR($J("",IOM)," ","="),!,"MISSING DOSE REPORT FROM "

 S Y=PSBSTRT D D^DIQ W Y," thru "

 S Y=PSBSTOP D D^DIQ W Y

 W ?(IOM-$L(PSBRPT("DATE"))),PSBRPT("DATE"),!,$S(PSBWRD:"SELECTED",1:"ALL")," WARDS"

 S X="Page: "_PSBRPT("PAGE")

 W ?(IOM-$L(X)),X

 S PSBRPT("PAGE")=PSBRPT("PAGE")+1

 W !,$TR($J("",IOM)," ","="),!,"Ward Location",?32,"Medication",?77,"Total",!,$TR($J("",IOM)," ","-"),!

 Q ""

 ;

POST ;

 N DFN

 S DFN=X D IN5^VADPT

 S PSBDDSW=$P(VAIP(5),U,2)

 S PSBDDSR=$P(VAIP(6),U,2)

 Q 

PSBOMD    ;BIRMINGHAM/EFC-MISSING DOSE REPORT ;Mar 2004

 +1       ;;3.0;BAR CODE MED ADMIN;;Mar 2004

 +2       ;

 +3       ; Reference/IA

 +4       ; WARD^NURSUT5/3052

 +5       ; IN5^VADPT/10061

 +6       ; $$GET1^DIQ(52.6/436

 +7       ; $$GET1^DIQ(52.7/437

 +8       ;

EN        ; Begin printing

 +1        NEW PSBSCHD,PSBWRD,PSBSTRT,PSBSTOP,PSBWARD,PSBDRUG,PSBDT,PSBIEN,PSBWRDA

 +2        KILL ^TMP("PSB",$JOB)

 +3        SET PSBWRD=+$PIECE(PSBRPT(.1),U,3)

 +4        IF PSBWRD

               DO WARD^NURSUT5("L^"_PSBWRD,.PSBWRDA)

               SET X=""

               FOR 

                   SET X=$ORDER(PSBWRDA(PSBWRD,2,X))

                   IF X=""

                       QUIT 

                   SET Y=PSBWRDA(PSBWRD,2,X,.01)

                   SET PSBWRD(+Y)=$PIECE(Y,U,2)

                   SET ^TMP("PSB",$JOB,PSBWRD(+Y))=0

 +5        SET PSBSTRT=$PIECE(PSBRPT(.1),U,6)+$PIECE(PSBRPT(.1),U,7)

 +6        SET PSBSTOP=$PIECE(PSBRPT(.1),U,8)+$PIECE(PSBRPT(.1),U,9)

 +7        SET PSBDT=PSBSTRT-.0000001

 +8        FOR 

               SET PSBDT=$ORDER(^PSB(53.68,"ADTE",PSBDT))

               IF 'PSBDT!(PSBDT>PSBSTOP)

                   QUIT 

               Begin DoDot:1

 +9                SET PSBIEN=0

 +10               FOR 

                       SET PSBIEN=$ORDER(^PSB(53.68,"ADTE",PSBDT,PSBIEN))

                       IF 'PSBIEN

                           QUIT 

                       Begin DoDot:2

 +11                       IF PSBWRD&('$DATA(PSBWRD(+$PIECE($GET(^PSB(53.68,PSBIEN,.1)),U,2))))

                               QUIT 

 +12                       SET PSBWARD=$$GET1^DIQ(53.68,PSBIEN_",",.12)

                           IF PSBWARD=""

                               QUIT 

 +13                       SET PSBDRUG=$$GET1^DIQ(53.68,PSBIEN_",",.13)

                           IF PSBDRUG=""

                               Begin DoDot:3

 +14                               SET PSBDRUG="NO DATA"

 +15                               IF $DATA(^PSB(53.68,PSBIEN,.6))

                                       SET X=0

                                       FOR 

                                           SET X=$ORDER(^PSB(53.68,+PSBIEN,.6,X))

                                           IF 'X

                                               QUIT 

                                           SET PSBDRUG=$$GET1^DIQ(52.6,+^PSB(53.68,PSBIEN,.6,X,0),.01)

 +16                               IF $DATA(^PSB(53.68,PSBIEN,.7))

                                       SET X=0

                                       FOR 

                                           SET X=$ORDER(^PSB(53.68,+PSBIEN,.7,X))

                                           IF 'X

                                               QUIT 

                                           SET PSBDRUG=PSBDRUG_"  "_$$GET1^DIQ(52.7,+^PSB(53.68,+PSBIEN,.7,X,0),.01)

                               End DoDot:3

 +17                       SET PSBSCHD=$$GET1^DIQ(53.68,PSBIEN_",",.19)

                           IF PSBSCHD=""

                               SET PSBSCHD="NO DATA"

 +18                       SET ^TMP("PSB",$JOB,PSBWARD,PSBDRUG,PSBSCHD)=$GET(^TMP("PSB",$JOB,PSBWARD,PSBDRUG,PSBSCHD))+1

 +19                       SET ^TMP("PSB",$JOB,PSBWARD)=+$GET(^TMP("PSB",$JOB,PSBWARD))+1

 +20                       SET ^TMP("PSB",$JOB)=+$GET(^TMP("PSB",$JOB))+1

                       End DoDot:2

               End DoDot:1

 +21       WRITE $$HDR()

 +22       IF '$DATA(^TMP("PSB",$JOB))

               WRITE !!?5,"<<<NO MISSING DOSE REQUESTS FOR THIS TIME FRAME>>>"

               QUIT 

 +23       SET PSBWARD=""

 +24       FOR 

               SET PSBWARD=$ORDER(^TMP("PSB",$JOB,PSBWARD))

               IF PSBWARD=""

                   QUIT 

               Begin DoDot:1

 +25               IF $Y>(IOSL-10)

                       WRITE $$HDR()

 +26               WRITE !,PSBWARD

 +27               SET (PSBDRUG,PSBSCHD)=""

 +28               FOR 

                       SET PSBDRUG=$ORDER(^TMP("PSB",$JOB,PSBWARD,PSBDRUG))

                       IF PSBDRUG=""

                           QUIT 

                       Begin DoDot:2

 +29                       FOR 

                               SET PSBSCHD=$ORDER(^TMP("PSB",$JOB,PSBWARD,PSBDRUG,PSBSCHD))

                               IF PSBSCHD=""

                                   QUIT 

                               Begin DoDot:3

 +30                               IF $Y>(IOSL-10)

                                       WRITE $$HDR()

 +31                               WRITE ?32,PSBDRUG,?74,$JUSTIFY(+^TMP("PSB",$JOB,PSBWARD,PSBDRUG,PSBSCHD),8),!,?35,"Schedule: "_PSBSCHD,!

                               End DoDot:3

                       End DoDot:2

 +32               WRITE ?74,"--------"

 +33               WRITE !?32,"Ward ",PSBWARD," Total: ",?74,$JUSTIFY(^TMP("PSB",$JOB,PSBWARD),8),!

               End DoDot:1

 +34       WRITE ?74,"========"

 +35       WRITE !?32,"Report Total: ",?74,$JUSTIFY(+$GET(^TMP("PSB",$JOB)),8)

 +36       KILL ^TMP("PSB",$JOB)

 +37       QUIT 

 +38      ;

HDR()     ;

 +1        IF '$DATA(PSBRPT("DATE"))

               DO NOW^%DTC

               SET Y=+$EXTRACT(%,1,12)

               DO D^DIQ

               SET PSBRPT("DATE")="Run Date: "_Y

 +2        IF '$DATA(PSBRPT("PAGE"))

               SET PSBRPT("PAGE")=1

 +3        IF $Y>1

               WRITE @IOF

 +4        WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","="),!,"MISSING DOSE REPORT FROM "

 +5        SET Y=PSBSTRT

           DO D^DIQ

           WRITE Y," thru "

 +6        SET Y=PSBSTOP

           DO D^DIQ

           WRITE Y

 +7        WRITE ?(IOM-$LENGTH(PSBRPT("DATE"))),PSBRPT("DATE"),!,$SELECT(PSBWRD:"SELECTED",1:"ALL")," WARDS"

 +8        SET X="Page: "_PSBRPT("PAGE")

 +9        WRITE ?(IOM-$LENGTH(X)),X

 +10       SET PSBRPT("PAGE")=PSBRPT("PAGE")+1

 +11       WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","="),!,"Ward Location",?32,"Medication",?77,"Total",!,$TRANSLATE($JUSTIFY("",IOM)," ","-"),!

 +12       QUIT ""

 +13      ;

POST      ;

 +1        NEW DFN

 +2        SET DFN=X

           DO IN5^VADPT

 +3        SET PSBDDSW=$PIECE(VAIP(5),U,2)

 +4        SET PSBDDSR=$PIECE(VAIP(6),U,2)

 +5        QUIT