ABMDE8DA.m

ABMDE8DA ; IHS/ASDST/DMJ - PAGE 8D - MED VIEW OPTION ; 

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;

 S ABMZ("PG")="8D"

 S ABMZ("TITL")="MEDICATION VIEW OPTION" D SUM^ABMDE1

 S ABMA("C")=0,ABMA("D")="",$P(ABMA("D"),"-",80)=""

 D HD

 S ABMA("OUT")=0,ABMA=ABMP("VDT")-1 F  S ABMA=$O(^PSRX("AD",ABMA)) Q:'ABMA  D  Q:ABMA("OUT")

 .Q:ABMA<ABMP("VDT")

 .I $D(ABMP("DDT")),ABMA>ABMP("DDT") S ABMA("OUT")=1 Q

 .I '$D(ABMP("DDT")),ABMA>ABMP("VDT") S ABMA("OUT")=1 Q

 .S ABMA("R")=0 F  S ABMA("R")=$O(^PSRX("AD",ABMA,ABMA("R"))) Q:'ABMA("R")  Q:'$D(^PSRX(ABMA("R"),0))  I $P(^(0),U,2)=ABMP("PDFN") S ABMA(0)=^(0),ABMA(2)=^(2) D V1 Q:$D(DTOUT)!$D(DUOUT)

 I ABMA("C")=0 W *7,!,"There have been no Drugs issued through the Pharmacy System to this Patient",!,"for the visit date(s) in concern."

 D ^ABMDERR

 G XIT

 ;

V1 S ABMA("C")=ABMA("C")+1

 I $Y+5>IOSL K DIR S DIR(0)="E" D ^DIR K DIR Q:$D(DTOUT)!$D(DUOUT)  W $$EN^ABMVDF("IOF") D HD

 W !,$P(ABMA(0),U),?8,$S($D(^PSDRUG(+$P(ABMA(0),U,6),0)):$P(^(0),U),1:"NOT ON FILE"),?43,$J($P(ABMA(0),U,7),6)

 S ABMA("DT")=$P(ABMA(2),U,2) S:'+ABMA("DT") ABMA("DT")=$P(ABMA(0),U,13)

 S ABMA("F")=$P(ABMA(0),U,9),ABMA("I")=0

 F  S ABMA("I")=$O(^PSRX(ABMA("R"),1,ABMA("I"))) Q:'ABMA("I")  S:^(ABMA("I"),0)>ABMA("DT") ABMA("DT")=+^(0) S ABMA("F")=ABMA("F")-1

 W ?53,$$HDT^ABMDUTL($P(ABMA(0),U,13))

 W:ABMA("DT") ?63,$$HDT^ABMDUTL(ABMA("DT")) W ?74,"(",ABMA("F"),")"

 W !?10,"NDC#: ",$P($G(^PSDRUG($P(ABMA(0),U,6),2)),U,4)

 S DIC="^PSRX(",DR=12,DIQ="ABMA(",DIQ(0)="E" D

 .N DA S DA=ABMA("R")

 .D EN^DIQ1 K DIQ Q:ABMA(52,DA,12,"E")=""

 .W !,?10,"Comments: ",ABMA(52,DA,12,"E")

 Q

 ;

HD W !?10,"***** MEDICATIONS ENTERED THROUGH THE PHARMACY SYSTEM *****"

 W !!,"Rx#     Drug",?46,"Qty",?53,"Issued ",?63,"Last Fill  Rem"

 W !,ABMA("D")

 Q

 ;

XIT K ABMA,DUOUT,DTOUT

 Q

ABMDE8DA  ; IHS/ASDST/DMJ - PAGE 8D - MED VIEW OPTION ; 

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;

 +3        SET ABMZ("PG")="8D"

 +4        SET ABMZ("TITL")="MEDICATION VIEW OPTION"

           DO SUM^ABMDE1

 +5        SET ABMA("C")=0

           SET ABMA("D")=""

           SET $PIECE(ABMA("D"),"-",80)=""

 +6        DO HD

 +7        SET ABMA("OUT")=0

           SET ABMA=ABMP("VDT")-1

           FOR 

               SET ABMA=$ORDER(^PSRX("AD",ABMA))

               IF 'ABMA

                   QUIT 

               Begin DoDot:1

 +8                IF ABMA<ABMP("VDT")

                       QUIT 

 +9                IF $DATA(ABMP("DDT"))

                       IF ABMA>ABMP("DDT")

                           SET ABMA("OUT")=1

                           QUIT 

 +10               IF '$DATA(ABMP("DDT"))

                       IF ABMA>ABMP("VDT")

                           SET ABMA("OUT")=1

                           QUIT 

 +11               SET ABMA("R")=0

                   FOR 

                       SET ABMA("R")=$ORDER(^PSRX("AD",ABMA,ABMA("R")))

                       IF 'ABMA("R")

                           QUIT 

                       IF '$DATA(^PSRX(ABMA("R"),0))

                           QUIT 

                       IF $PIECE(^(0),U,2)=ABMP("PDFN")

                           SET ABMA(0)=^(0)

                           SET ABMA(2)=^(2)

                           DO V1

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

                               QUIT 

               End DoDot:1

               IF ABMA("OUT")

                   QUIT 

 +12       IF ABMA("C")=0

               WRITE *7,!,"There have been no Drugs issued through the Pharmacy System to this Patient",!,"for the visit date(s) in concern."

 +13       DO ^ABMDERR

 +14       GOTO XIT

 +15      ;

V1         SET ABMA("C")=ABMA("C")+1

 +1        IF $Y+5>IOSL

               KILL DIR

               SET DIR(0)="E"

               DO ^DIR

               KILL DIR

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

                   QUIT 

               WRITE $$EN^ABMVDF("IOF")

               DO HD

 +2        WRITE !,$PIECE(ABMA(0),U),?8,$SELECT($DATA(^PSDRUG(+$PIECE(ABMA(0),U,6),0)):$PIECE(^(0),U),1:"NOT ON FILE"),?43,$JUSTIFY($PIECE(ABMA(0),U,7),6)

 +3        SET ABMA("DT")=$PIECE(ABMA(2),U,2)

           IF '+ABMA("DT")

               SET ABMA("DT")=$PIECE(ABMA(0),U,13)

 +4        SET ABMA("F")=$PIECE(ABMA(0),U,9)

           SET ABMA("I")=0

 +5        FOR 

               SET ABMA("I")=$ORDER(^PSRX(ABMA("R"),1,ABMA("I")))

               IF 'ABMA("I")

                   QUIT 

               IF ^(ABMA("I"),0)>ABMA("DT")

                   SET ABMA("DT")=+^(0)

               SET ABMA("F")=ABMA("F")-1

 +6        WRITE ?53,$$HDT^ABMDUTL($PIECE(ABMA(0),U,13))

 +7        IF ABMA("DT")

               WRITE ?63,$$HDT^ABMDUTL(ABMA("DT"))

           WRITE ?74,"(",ABMA("F"),")"

 +8        WRITE !?10,"NDC#: ",$PIECE($GET(^PSDRUG($PIECE(ABMA(0),U,6),2)),U,4)

 +9        SET DIC="^PSRX("

           SET DR=12

           SET DIQ="ABMA("

           SET DIQ(0)="E"

           Begin DoDot:1

 +10           NEW DA

               SET DA=ABMA("R")

 +11           DO EN^DIQ1

               KILL DIQ

               IF ABMA(52,DA,12,"E")=""

                   QUIT 

 +12           WRITE !,?10,"Comments: ",ABMA(52,DA,12,"E")

           End DoDot:1

 +13       QUIT 

 +14      ;

HD         WRITE !?10,"***** MEDICATIONS ENTERED THROUGH THE PHARMACY SYSTEM *****"

 +1        WRITE !!,"Rx#     Drug",?46,"Qty",?53,"Issued ",?63,"Last Fill  Rem"

 +2        WRITE !,ABMA("D")

 +3        QUIT 

 +4       ;

XIT        KILL ABMA,DUOUT,DTOUT

 +1        QUIT