Routine: APCLPDEM

APCLPDEM ; IHS/CMI/LAB - report of visits re-linked ;

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

START ;EP - called from option

 D XIT

 W:$D(IOF) @IOF

 W !!,"This option will print a list of all visits for your 'DEMO' patients."

 W !,"The patient visits listed are those for patients whose name begins with"

 W !,"DEMO,PATIENT or who reside in your site defined DEMO patient search template."

 W !!,"You can use this list to delete the visits using the data entry delete"

 W !,"visit option."

W !

GETDATES ;

 W !!,"Please enter the range of visit dates for the demo patients."

BD ;get beginning date

 W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G XIT

 S APCLBD=Y

ED ;get ending date

 W ! S DIR(0)="D^"_APCLBD_":DT:EP",DIR("A")="Enter ending Date" S Y=APCLBD D DD^%DT D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G BD

 S APCLED=Y

 S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X S Y=APCLBD D DD^%DT S APCLBDD=Y S Y=APCLED D DD^%DT S APCLEDD=Y

ZIS ;

DEMO ;

 D DEMOCHK^APCLUTL(.APCLDEMO)

 I APCLDEMO=-1 G GETDATES

 S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to ",DIR("B")="P" K DA D ^DIR K DIR

 I $D(DIRUT) G XIT

 I $G(Y)="B" D BROWSE,XIT Q

 W !! S XBRP="PRINT^APCLPDEM",XBRC="PROC^APCLPDEM",XBNS="APCL*",XBRX="XIT^APCLPDEM"

 D ^XBDBQUE

 D XIT

BROWSE ;

 S XBRP="VIEWR^XBLM(""PRINT^APCLPDEM"")"

 S XBNS="APCL",XBRC="PROC^APCLPDEM",XBRX="XIT^APCLPDEM",XBIOP=0 D ^XBDBQUE

PROC ;EP - called from xbdbque

 ;loop through all visits in date range and look for DEMO patient visits

 S APCLJOB=$J,APCLTOT=0,APCLBT=$H

 D XTMP("APCLPDEM","DEMO PATIENT VISIT LIST")

 S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X

 S APCLODAT=APCLSD_".9999" F  S APCLODAT=$O(^AUPNVSIT("B",APCLODAT)) Q:APCLODAT=""!((APCLODAT\1)>APCLED)  D

 .S APCLV=0 F  S APCLV=$O(^AUPNVSIT("B",APCLODAT,APCLV)) Q:APCLV'=+APCLV  D

 ..Q:$P(^AUPNVSIT(APCLV,0),U,11)

 ..Q:$P(^AUPNVSIT(APCLV,0),U,5)=""

 ..Q:$$DEMO^APCLUTL($P(^AUPNVSIT(APCLV,0),U,5),$G(APCLDEMO))

 ..S ^XTMP("APCLPDEM",APCLJOB,APCLBT,"VISITS",$P(^AUPNVSIT(APCLV,0),U,5),APCLV)="",APCLTOT=APCLTOT+1

PRINT ;EP - called from xbdbque

 K APCLQ S APCLPG=0

 I '$D(^XTMP("APCLPDEM",APCLJOB,APCLBT,"VISITS")) D HEADER W !!,"There are no Demo patient visits for that time period.",! Q

 D HEADER

 S APCLP=0 F  S APCLP=$O(^XTMP("APCLPDEM",APCLJOB,APCLBT,"VISITS",APCLP)) Q:APCLP=""!($D(APCLQ))  D

 .S APCLV=0 F  S APCLV=$O(^XTMP("APCLPDEM",APCLJOB,APCLBT,"VISITS",APCLP,APCLV)) Q:APCLV'=+APCLV!($D(APCLQ))  D

 ..I $Y>(IOSL-4) D HEADER Q:$D(APCLQ)

 ..W !,$$HRN^AUPNPAT(APCLP,DUZ(2)),?7,$E($P(^DPT(APCLP,0),U),1,22),?29,$$FMTE^XLFDT($P(^AUPNVSIT(APCLV,0),U),1)," (",APCLV,")",?62,$P(^AUPNVSIT(APCLV,0),U,3),?65,$P(^AUPNVSIT(APCLV,0),U,7),?68,$E($$CLINIC^APCLV(APCLV,"E"),1,12)

 W !!,"Total # of Visits: ",APCLTOT,!

 K ^XTMP("APCLPDEM",APCLJOB,APCLBT)

XIT ;

 D EN^XBVK("APCL")

 D KILL^AUPNPAT

CTR(X,Y) ;EP - Center X in a field Y wide.

 Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X

 ;----------

HEADER ;EP

 I 'APCLPG G HEADER1

 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQ="" Q

HEADER1 ;

 W:$D(IOF) @IOF S APCLPG=APCLPG+1

 W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 W !?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),?($S(80=132:120,1:72)),"Page ",APCLPG,!

 S APCLTEXT="'DEMO' PATIENT VISITS"

 W !?(80-$L(APCLTEXT)/2),APCLTEXT,!

 S APCLTEXT="Visit Dates:  "_APCLBDD_" and "_APCLEDD

 W ?(80-$L(APCLTEXT)/2),APCLTEXT,!

 W $TR($J(" ",80)," ","-")

 W !,"HRN",?7,"PATIENT",?32,"DATE/TIME (IEN)",?60,"TYPE",?65,"SC",?68,"CLINIC"

 W !,$TR($J(" ",80)," ","-")

DATE(D) ;EP

 I D="" Q ""

 Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)

XTMP(N,D) ;EP - set xtmp 0 node

 Q:$G(N)=""

 S ^XTMP(N,0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_$G(D)

APCLPDEM  ; IHS/CMI/LAB - report of visits re-linked ;

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

 +2       ;

 +3       ;

START     ;EP - called from option

 +1        DO XIT

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        WRITE !!,"This option will print a list of all visits for your 'DEMO' patients."

 +4        WRITE !,"The patient visits listed are those for patients whose name begins with"

 +5        WRITE !,"DEMO,PATIENT or who reside in your site defined DEMO patient search template."

 +6        WRITE !!,"You can use this list to delete the visits using the data entry delete"

 +7        WRITE !,"visit option."

 +8        WRITE !

 +9       ;

GETDATES  ;

 +1        WRITE !!,"Please enter the range of visit dates for the demo patients."

BD        ;get beginning date

 +1        WRITE !

           SET DIR(0)="D^:DT:EP"

           SET DIR("A")="Enter beginning Date"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO XIT

 +3        SET APCLBD=Y

ED        ;get ending date

 +1        WRITE !

           SET DIR(0)="D^"_APCLBD_":DT:EP"

           SET DIR("A")="Enter ending Date"

           SET Y=APCLBD

           DO DD^%DT

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO BD

 +3        SET APCLED=Y

 +4        SET X1=APCLBD

           SET X2=-1

           DO C^%DTC

           SET APCLSD=X

           SET Y=APCLBD

           DO DD^%DT

           SET APCLBDD=Y

           SET Y=APCLED

           DO DD^%DT

           SET APCLEDD=Y

ZIS       ;

DEMO      ;

 +1        DO DEMOCHK^APCLUTL(.APCLDEMO)

 +2        IF APCLDEMO=-1

               GOTO GETDATES

 +3        SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"

           SET DIR("A")="Do you wish to "

           SET DIR("B")="P"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               GOTO XIT

 +5        IF $GET(Y)="B"

               DO BROWSE

               DO XIT

               QUIT

 +6        WRITE !!

           SET XBRP="PRINT^APCLPDEM"

           SET XBRC="PROC^APCLPDEM"

           SET XBNS="APCL*"

           SET XBRX="XIT^APCLPDEM"

 +7        DO ^XBDBQUE

 +8        DO XIT

 +9        QUIT

BROWSE    ;

 +1        SET XBRP="VIEWR^XBLM(""PRINT^APCLPDEM"")"

 +2        SET XBNS="APCL"

           SET XBRC="PROC^APCLPDEM"

           SET XBRX="XIT^APCLPDEM"

           SET XBIOP=0

           DO ^XBDBQUE

 +3        QUIT

 +4       ;

PROC      ;EP - called from xbdbque

 +1       ;loop through all visits in date range and look for DEMO patient visits

 +2        SET APCLJOB=$JOB

           SET APCLTOT=0

           SET APCLBT=$HOROLOG

 +3        DO XTMP("APCLPDEM","DEMO PATIENT VISIT LIST")

 +4        SET X1=APCLBD

           SET X2=-1

           DO C^%DTC

           SET APCLSD=X

 +5        SET APCLODAT=APCLSD_".9999"

FOR

               SET APCLODAT=$ORDER(^AUPNVSIT("B",APCLODAT))

               IF APCLODAT=""!((APCLODAT\1)>APCLED)

                   QUIT

               Begin DoDot:1

 +6                SET APCLV=0

FOR

                       SET APCLV=$ORDER(^AUPNVSIT("B",APCLODAT,APCLV))

                       IF APCLV'=+APCLV

                           QUIT

                       Begin DoDot:2

 +7                        IF $PIECE(^AUPNVSIT(APCLV,0),U,11)

                               QUIT

 +8                        IF $PIECE(^AUPNVSIT(APCLV,0),U,5)=""

                               QUIT

 +9                        IF $$DEMO^APCLUTL($PIECE(^AUPNVSIT(APCLV,0),U,5),$GET(APCLDEMO))

                               QUIT

 +10                       SET ^XTMP("APCLPDEM",APCLJOB,APCLBT,"VISITS",$PIECE(^AUPNVSIT(APCLV,0),U,5),APCLV)=""

                           SET APCLTOT=APCLTOT+1

                       End DoDot:2

               End DoDot:1

 +11       QUIT

PRINT     ;EP - called from xbdbque

 +1        KILL APCLQ

           SET APCLPG=0

 +2        IF '$DATA(^XTMP("APCLPDEM",APCLJOB,APCLBT,"VISITS"))

               DO HEADER

               WRITE !!,"There are no Demo patient visits for that time period.",!

               QUIT

 +3        DO HEADER

 +4        SET APCLP=0

FOR

               SET APCLP=$ORDER(^XTMP("APCLPDEM",APCLJOB,APCLBT,"VISITS",APCLP))

               IF APCLP=""!($DATA(APCLQ))

                   QUIT

               Begin DoDot:1

 +5                SET APCLV=0

FOR

                       SET APCLV=$ORDER(^XTMP("APCLPDEM",APCLJOB,APCLBT,"VISITS",APCLP,APCLV))

                       IF APCLV'=+APCLV!($DATA(APCLQ))

                           QUIT

                       Begin DoDot:2

 +6                        IF $Y>(IOSL-4)

                               DO HEADER

                               IF $DATA(APCLQ)

                                   QUIT

 +7                        WRITE !,$$HRN^AUPNPAT(APCLP,DUZ(2)),?7,$EXTRACT($PIECE(^DPT(APCLP,0),U),1,22),?29,$$FMTE^XLFDT($PIECE(^AUPNVSIT(APCLV,0),U),1)," (",APCLV,")",?62,$PIECE(^AUPNVSIT(APCLV,0),U,3),?65,$PIECE(^AUPNVSIT(APCLV,0),U,7),?68,$EXTRACT($$C

LINIC^APCLV(APCLV,"E"),1,12)

                       End DoDot:2

               End DoDot:1

 +8        WRITE !!,"Total # of Visits: ",APCLTOT,!

 +9        KILL ^XTMP("APCLPDEM",APCLJOB,APCLBT)

XIT       ;

 +1        DO EN^XBVK("APCL")

 +2        DO KILL^AUPNPAT

 +3        QUIT

CTR(X,Y)  ;EP - Center X in a field Y wide.

 +1        QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X

 +2       ;----------

HEADER    ;EP

 +1        IF 'APCLPG

               GOTO HEADER1

 +2        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   WRITE !

                   SET DIR(0)="EO"

                   DO ^DIR

                   KILL DIR

                   IF Y=0!(Y="^")!($DATA(DTOUT))

                       SET APCLQ=""

                       QUIT

HEADER1   ;

 +1        IF $DATA(IOF)

               WRITE @IOF

           SET APCLPG=APCLPG+1

 +2        WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 +3        WRITE !?(80-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))/2),$PIECE(^DIC(4,DUZ(2),0),U),?($SELECT(80=132:120,1:72)),"Page ",APCLPG,!

 +4        SET APCLTEXT="'DEMO' PATIENT VISITS"

 +5        WRITE !?(80-$LENGTH(APCLTEXT)/2),APCLTEXT,!

 +6        SET APCLTEXT="Visit Dates:  "_APCLBDD_" and "_APCLEDD

 +7        WRITE ?(80-$LENGTH(APCLTEXT)/2),APCLTEXT,!

 +8        WRITE $TRANSLATE($JUSTIFY(" ",80)," ","-")

 +9        WRITE !,"HRN",?7,"PATIENT",?32,"DATE/TIME (IEN)",?60,"TYPE",?65,"SC",?68,"CLINIC"

 +10       WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")

 +11       QUIT

DATE(D)   ;EP

 +1        IF D=""

               QUIT ""

 +2        QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)

 +3       ;

XTMP(N,D) ;EP - set xtmp 0 node

 +1        IF $GET(N)=""

               QUIT

 +2        SET ^XTMP(N,0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_$GET(D)

 +3        QUIT

 +4       ;

 +5       ;

APCLPDEM.m