APCDVDP.m

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

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

 ;

 ;V 2.41

 ;

 D START

 I '$G(APCDVDSP) 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 APCDVDSP="",APCDPAT=""

 S AUPNLK("INAC")=""

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

 S APCDPAT=+Y

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

 D GETVISIT^APCDDISP

 I '$G(APCDVSIT) S APCXFLAG=1 Q

 S APCDVDSP=APCDVSIT

 ;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^APCDVDP",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 AUPNLK

 D EN^XBVK("APCD")

 K APCXLAST,APCXVDFN,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,APCXFLAG,APCDVDSP,AUPNDAYS

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

 Q

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

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

 +2       ;

 +3       ;V 2.41

 +4       ;

 +5        DO START

 +6        IF '$GET(APCDVDSP)

               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 APCDVDSP=""

           SET APCDPAT=""

 +2        SET AUPNLK("INAC")=""

 +3        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

           IF Y<1

               SET APCXFLAG=1

               QUIT 

 +4        SET APCDPAT=+Y

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

 +6        DO GETVISIT^APCDDISP

 +7        IF '$GET(APCDVSIT)

               SET APCXFLAG=1

               QUIT 

 +8        SET APCDVDSP=APCDVSIT

 +9       ;S APCDVDSP=APCXVDFN

 +10       QUIT 

 +11      ;

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^APCDVDP"

           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 AUPNLK

 +3        DO EN^XBVK("APCD")

 +4        KILL APCXLAST,APCXVDFN,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,APCXFLAG,APCDVDSP,AUPNDAYS

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

 +6        QUIT