- 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
