APCLVST.m

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

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

 ;

 ;V 2.41

 ;

 D START

 I APCXFLAG 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 APCXFLAG=0

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

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

 S APCXLAST=$O(^AUPNVSIT("AA",AUPNPAT,"")),APCXVDFN=$O(^AUPNVSIT("AA",AUPNPAT,APCXLAST,""))

 S APCDVDSP=APCXVDFN

 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 APCXLAST,APCXVDFN,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,APCXFLAG,APCDVDSP,AUPNDAYS

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

 Q

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

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

 +2       ;

 +3       ;V 2.41

 +4       ;

 +5        DO START

 +6        IF APCXFLAG

               DO EOJ

               QUIT 

 +7        DO PRINT

 +8        IF POP

               DO EOJ

               QUIT 

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

               DO TSKMN

               DO EOJ

               QUIT 

 +10       USE IO

 +11       DO ^APCDVDSP

 +12       DO EOJ

 +13       QUIT 

 +14      ;

START     ;

 +1        SET APCXFLAG=0

 +2        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

           IF Y<1

               SET APCXFLAG=1

               QUIT 

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

               SET APCXFLAG=1

               QUIT 

 +4        SET APCXLAST=$ORDER(^AUPNVSIT("AA",AUPNPAT,""))

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

 +5        SET APCDVDSP=APCXVDFN

 +6        QUIT 

 +7       ;

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 APCXLAST,APCXVDFN,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,APCXFLAG,APCDVDSP,AUPNDAYS

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

 +4        QUIT