APCLPLCV.m

APCLPLCV ; IHS/CMI/LAB - PRINTS A PATIENT'S LAST CLINIC VISIT ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;

 ;V 2.41

 ;

 D START

 I APCLFLAG D EOJ Q

 I 'APCLFOUN W !!,?5,"** THIS PATIENT HAS NO RECORDED VISIT TO THE "_$P(^DIC(40.7,APCLCL,0),U)_" CLINIC **",! H 2 D EOJ Q

 D PRINT

 I POP D EOJ Q

 I $D(IO("Q")) D TSKMN,EOJ Q

 U IO

 D ^APCDVDSP

 D EOJ

 Q

 ;

START ;

 S APCLFLAG=0

 S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC I Y<1 S APCLFLAG=1 Q

 ;Get Clinic

 W !!,?8,"**This Report will display the LAST Visit to a specific CLINIC **",!!,?30,"for: "_$P(^DPT(AUPNPAT,0),U) W !

 ;

 K DIC S DIC=40.7,DIC(0)="AEQMZ",DIC("A")="Enter a Clinic:  " D ^DIC K DIC

 ;

 G START:Y<1 S APCLCL=+Y

 ;

 I '$D(^AUPNVSIT("AA",AUPNPAT)) S APCLFLAG=1 Q

 S APCLDATE=""

 S APCLFOUN=0

 F  S APCLDATE=$O(^AUPNVSIT("AA",AUPNPAT,APCLDATE)) Q:APCLDATE=""  Q:APCLFOUN  D

 .S APCLVDFN=0 F  S APCLVDFN=$O(^AUPNVSIT("AA",AUPNPAT,APCLDATE,APCLVDFN)) Q:APCLVDFN=""  Q:APCLFOUN  D

 ..Q:$P(^AUPNVSIT(APCLVDFN,0),U,8)'=APCLCL

 ..S APCLFOUN=APCLVDFN

 ..Q

 I APCLFOUN S APCDVDSP=APCLFOUN

 Q

 ;

PRINT ;

 W !! K IOP S %ZIS="PQ" K IO("Q") D ^%ZIS

 Q

 ;

TSKMN ;

 K ZTSAVE S ZTSAVE("APCDVDSP")="",ZTIO=ION,ZTRTN="ZTM^APCLVST",ZTDTH="",ZTDESC="LAST VISIT REPORT" D ^%ZTLOAD

 Q

 ;

ZTM ;ENTRY FOR TASK MANAGER

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

 U IO

 D ^APCDVDSP

 D ^%ZISC

 Q

 ;

EOJ ;ENTRY POINT

 D ^%ZISC

 K APCLLAST,APCLVDFN,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,APCLFLAG,APCDVDSP,APCLFOUN,APCLCL,AUPNDAYS

 K DIC,DA,X,Y,ZTSK,ZTQUEUED

 Q

APCLPLCV  ; IHS/CMI/LAB - PRINTS A PATIENT'S LAST CLINIC VISIT ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

 +3       ;V 2.41

 +4       ;

 +5        DO START

 +6        IF APCLFLAG

               DO EOJ

               QUIT 

 +7        IF 'APCLFOUN

               WRITE !!,?5,"** THIS PATIENT HAS NO RECORDED VISIT TO THE "_$PIECE(^DIC(40.7,APCLCL,0),U)_" CLINIC **",!

               HANG 2

               DO EOJ

               QUIT 

 +8        DO PRINT

 +9        IF POP

               DO EOJ

               QUIT 

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

               DO TSKMN

               DO EOJ

               QUIT 

 +11       USE IO

 +12       DO ^APCDVDSP

 +13       DO EOJ

 +14       QUIT 

 +15      ;

START     ;

 +1        SET APCLFLAG=0

 +2        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

           IF Y<1

               SET APCLFLAG=1

               QUIT 

 +3       ;Get Clinic

 +4        WRITE !!,?8,"**This Report will display the LAST Visit to a specific CLINIC **",!!,?30,"for: "_$PIECE(^DPT(AUPNPAT,0),U)

           WRITE !

 +5       ;

 +6        KILL DIC

           SET DIC=40.7

           SET DIC(0)="AEQMZ"

           SET DIC("A")="Enter a Clinic:  "

           DO ^DIC

           KILL DIC

 +7       ;

 +8        IF Y<1

               GOTO START

           SET APCLCL=+Y

 +9       ;

 +10       IF '$DATA(^AUPNVSIT("AA",AUPNPAT))

               SET APCLFLAG=1

               QUIT 

 +11       SET APCLDATE=""

 +12       SET APCLFOUN=0

 +13       FOR 

               SET APCLDATE=$ORDER(^AUPNVSIT("AA",AUPNPAT,APCLDATE))

               IF APCLDATE=""

                   QUIT 

               IF APCLFOUN

                   QUIT 

               Begin DoDot:1

 +14               SET APCLVDFN=0

                   FOR 

                       SET APCLVDFN=$ORDER(^AUPNVSIT("AA",AUPNPAT,APCLDATE,APCLVDFN))

                       IF APCLVDFN=""

                           QUIT 

                       IF APCLFOUN

                           QUIT 

                       Begin DoDot:2

 +15                       IF $PIECE(^AUPNVSIT(APCLVDFN,0),U,8)'=APCLCL

                               QUIT 

 +16                       SET APCLFOUN=APCLVDFN

 +17                       QUIT 

                       End DoDot:2

               End DoDot:1

 +18       IF APCLFOUN

               SET APCDVDSP=APCLFOUN

 +19       QUIT 

 +20      ;

PRINT     ;

 +1        WRITE !!

           KILL IOP

           SET %ZIS="PQ"

           KILL IO("Q")

           DO ^%ZIS

 +2        QUIT 

 +3       ;

TSKMN     ;

 +1        KILL ZTSAVE

           SET ZTSAVE("APCDVDSP")=""

           SET ZTIO=ION

           SET ZTRTN="ZTM^APCLVST"

           SET ZTDTH=""

           SET ZTDESC="LAST VISIT REPORT"

           DO ^%ZTLOAD

 +2        QUIT 

 +3       ;

ZTM       ;ENTRY FOR TASK MANAGER

 +1        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +2        USE IO

 +3        DO ^APCDVDSP

 +4        DO ^%ZISC

 +5        QUIT 

 +6       ;

EOJ       ;ENTRY POINT

 +1        DO ^%ZISC

 +2        KILL APCLLAST,APCLVDFN,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,APCLFLAG,APCDVDSP,APCLFOUN,APCLCL,AUPNDAYS

 +3        KILL DIC,DA,X,Y,ZTSK,ZTQUEUED

 +4        QUIT