APCLGV.m

APCLGV ; IHS/CMI/LAB - ACTIVE CLIENT LIST ;

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

 ;

 ;

START ;

 S APCLJOB=$J,APCLBTH=$H K DIR

 D XTMP^APCLOSUT("APCLGV","PCC REPORT ON PTS SEEN N TIMES")

 I '$D(IOF) D HOME^%ZIS

 W @(IOF),!!

 W ?10,"**********  PATIENTS SEEN AT LEAST N NUMBER OF TIMES  **********",!!

 W "This report will produce a report of patients who have been seen at least",!," N number of times in a date range specified by the user.",!

 W !,"The output form this report can be in the form of a list of patients",!,"or a search template.",!

GETDATES ;

BD ;get beginning date

 W !,"Please enter the date range during which the patient should be seen.",!

 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)="DA^"_APCLBD_":DT:EP",DIR("A")="Enter ending Date:  " S Y=APCLBD D DD^%DT S Y="" 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

 ;

 S APCLNCAN=1 D ADD^APCLVL01 I $D(APCLQUIT) D DEL^APCLVL K APCLQUIT G GETDATES

NUM ;

 ;S DIR(0)="N^2:100:0",DIR("A")="Enter the minimum number of times the patient should have been seen" D ^DIR K DIR S:$D(DUOUT) DIRUT=1 ;IHS/CMI/LAB 10/1/96

 S DIR(0)="N^1:100:0",DIR("A")="Enter the minimum number of times the patient should have been seen" D ^DIR K DIR S:$D(DUOUT) DIRUT=1 ;IHS/CMI/LAB 10/14/96

 G:$D(DIRUT) GETDATES

 G:Y="" GETDATES

 S APCLNUM=+Y

SCREEN ;

 S APCLTCW=0,APCLPTVS="V",APCLTYPE="D",APCLCTYP="T"

 K ^APCLVRPT(APCLRPT,11) S APCLCNTL="S" D ^APCLVL4 K APCLCNTL I $D(APCLQUIT) D DEL^APCLVL G GETDATES

OUTPUT ;IHS/TUCSON/LAB - added OUTPUT to SORT-1

 K APCLSTMP,APCLSNAM,APCLQUIT

 S APCLOUT=""

 S DIR(0)="S^L:List of Patients;S:Search Template of Patients",DIR("A")="Type of output",DIR("B")="L" KILL DA D ^DIR KILL DIR

 G:$D(DIRUT) SCREEN

 S APCLOUT=Y

 I APCLOUT'="S" G SORT

STEMP ;

 K APCLQUIT

 D ^APCLSTMP

 I $D(APCLQUIT) G OUTPUT

 I $G(APCLSTMP)=""!($G(APCLSNAM))="" K APCLQUIT W !,"No template selected!" G OUTPUT

 G ZIS

SORT ;

 S APCLTCW=0,APCLPTVS="P",APCLTYPE="D",APCLCTYP="T"

 S APCLCNTL="R" D ^APCLVL4 K APCLCNTL I $D(APCLQUIT) D DEL^APCLVL G GETDATES

PAGE ;

 S APCLNPAG=0,DIR(0)="Y",DIR("A")="Do you want each "_APCLSORV_" on a separate page",DIR("B")="N" K DA D ^DIR K DIR

 G:$D(DIRUT) SORT

 S APCLNPAG=Y

ZIS ;

DEMO ;

 D DEMOCHK^APCLUTL(.APCLDEMO)

 I APCLDEMO=-1 G OUTPUT

 S XBRC="PROC^APCLGV",XBRP="^APCLGVP",XBNS="APCL",XBRX="XIT^APCLGV"

 D ^XBDBQUE

XIT ;

 D ^XBFMK

 D EN^XBVK("APCL"),EN^XBVK("AMQQ")

 K I,J,K,P,X,Y,Z,%,DDH,DIV,DIU,DFN,DIG,DIW

 Q

 ;

PROC ;EP - entry point for processing

 S APCLTOT=0,DFN=0,APCLBT=$H

 F  S DFN=$O(^AUPNVSIT("AA",DFN)) Q:DFN'=+DFN  D PROC1

 S APCLET=$H

 K DFN

 Q

PROC1 ;

 S APCLR=0,APCLBDO=(9999999-APCLBD)_".9999",APCLEDO=(9999999-APCLED),APCLSD=(APCLEDO-1)_".9999",APCLRCNT=0

 F  S APCLSD=$O(^AUPNVSIT("AA",DFN,APCLSD)) Q:APCLSD>APCLBDO!(APCLSD="")  D

 .S APCLVIEN=0 F  S APCLVIEN=$O(^AUPNVSIT("AA",DFN,APCLSD,APCLVIEN)) Q:APCLVIEN'=+APCLVIEN  D

 ..Q:'$P(^AUPNVSIT(APCLVIEN,0),U,9)

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

 ..S APCLVREC=^AUPNVSIT(APCLVIEN,0)

 ..Q:$$DEMO^APCLUTL($P(APCLVREC,U,5),$G(APCLDEMO))

 ..D SCREENS

 ..Q:$D(APCLSKIP)

 ..S APCLRCNT=APCLRCNT+1 ;COUNT # VISITS

 .Q

 I APCLRCNT'<APCLNUM D

 .I APCLOUT="S" S ^XTMP("APCLGV",APCLJOB,APCLBTH,"PATIENTS","TEMPLATE",DFN)="",APCLTOT=APCLTOT+1 Q

 .K APCLSRT,APCLPRNT S APCLCRIT=APCLSORT,APCLX=0

 .X:$D(^APCLVSTS(APCLSORT,4)) ^APCLVSTS(APCLSORT,4)

 .S APCLSRT=$G(APCLPRNT) S:APCLSRT="" APCLSRT="??"

 .S ^XTMP("APCLGV",APCLJOB,APCLBTH,"PATIENTS",APCLSRT,DFN)="",APCLTOT=APCLTOT+1

 Q

 ;

SCREENS ;EP

 K APCLSKIP

 S APCLI=0 F  S APCLI=$O(^APCLVRPT(APCLRPT,11,APCLI)) Q:APCLI'=+APCLI!($D(APCLSKIP))  D

 .I '$P(^APCLVSTS(APCLI,0),U,8) D SINGLE Q

 .D MULT

 .Q

 Q

SINGLE ;

 K X,APCLSPEC S X="",APCLX=0

 X:$D(^APCLVSTS(APCLI,1)) ^(1)

 I X="" S APCLSKIP="" Q

 I '$D(APCLSPEC),'$D(^APCLVRPT(APCLRPT,11,APCLI,11,"B",X)) S APCLSKIP="" Q

 Q

MULT ;

 K APCLFOUN,APCLSKIP,APCLSPEC,X S APCLX=0,X=""

 X:$D(^APCLVSTS(APCLI,1)) ^(1)

 I $O(X(""))="" S APCLSKIP="" Q

 I '$D(APCLSPEC) S Y="" F  S Y=$O(X(Y)) Q:Y=""  I $D(^APCLVRPT(APCLRPT,11,APCLI,11,"B",Y)) S APCLFOUN="" Q

 I $D(APCLSPEC),$D(X) S APCLFOUN=1 Q

 S:'$D(APCLFOUN) APCLSKIP=""

 Q

APCLGV    ; IHS/CMI/LAB - ACTIVE CLIENT LIST ;

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

 +2       ;

 +3       ;

START     ;

 +1        SET APCLJOB=$JOB

           SET APCLBTH=$HOROLOG

           KILL DIR

 +2        DO XTMP^APCLOSUT("APCLGV","PCC REPORT ON PTS SEEN N TIMES")

 +3        IF '$DATA(IOF)

               DO HOME^%ZIS

 +4        WRITE @(IOF),!!

 +5        WRITE ?10,"**********  PATIENTS SEEN AT LEAST N NUMBER OF TIMES  **********",!!

 +6        WRITE "This report will produce a report of patients who have been seen at least",!," N number of times in a date range specified by the user.",!

 +7        WRITE !,"The output form this report can be in the form of a list of patients",!,"or a search template.",!

GETDATES  ;

BD        ;get beginning date

 +1        WRITE !,"Please enter the date range during which the patient should be seen.",!

 +2        WRITE !

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

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

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               GOTO XIT

 +4        SET APCLBD=Y

ED        ;get ending date

 +1        WRITE !

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

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

           SET Y=APCLBD

           DO DD^%DT

           SET Y=""

           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

 +5       ;

 +6        SET APCLNCAN=1

           DO ADD^APCLVL01

           IF $DATA(APCLQUIT)

               DO DEL^APCLVL

               KILL APCLQUIT

               GOTO GETDATES

NUM       ;

 +1       ;S DIR(0)="N^2:100:0",DIR("A")="Enter the minimum number of times the patient should have been seen" D ^DIR K DIR S:$D(DUOUT) DIRUT=1 ;IHS/CMI/LAB 10/1/96

 +2       ;IHS/CMI/LAB 10/14/96

           SET DIR(0)="N^1:100:0"

           SET DIR("A")="Enter the minimum number of times the patient should have been seen"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               GOTO GETDATES

 +4        IF Y=""

               GOTO GETDATES

 +5        SET APCLNUM=+Y

SCREEN    ;

 +1        SET APCLTCW=0

           SET APCLPTVS="V"

           SET APCLTYPE="D"

           SET APCLCTYP="T"

 +2        KILL ^APCLVRPT(APCLRPT,11)

           SET APCLCNTL="S"

           DO ^APCLVL4

           KILL APCLCNTL

           IF $DATA(APCLQUIT)

               DO DEL^APCLVL

               GOTO GETDATES

OUTPUT    ;IHS/TUCSON/LAB - added OUTPUT to SORT-1

 +1        KILL APCLSTMP,APCLSNAM,APCLQUIT

 +2        SET APCLOUT=""

 +3        SET DIR(0)="S^L:List of Patients;S:Search Template of Patients"

           SET DIR("A")="Type of output"

           SET DIR("B")="L"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               GOTO SCREEN

 +5        SET APCLOUT=Y

 +6        IF APCLOUT'="S"

               GOTO SORT

STEMP     ;

 +1        KILL APCLQUIT

 +2        DO ^APCLSTMP

 +3        IF $DATA(APCLQUIT)

               GOTO OUTPUT

 +4        IF $GET(APCLSTMP)=""!($GET(APCLSNAM))=""

               KILL APCLQUIT

               WRITE !,"No template selected!"

               GOTO OUTPUT

 +5        GOTO ZIS

SORT      ;

 +1        SET APCLTCW=0

           SET APCLPTVS="P"

           SET APCLTYPE="D"

           SET APCLCTYP="T"

 +2        SET APCLCNTL="R"

           DO ^APCLVL4

           KILL APCLCNTL

           IF $DATA(APCLQUIT)

               DO DEL^APCLVL

               GOTO GETDATES

PAGE      ;

 +1        SET APCLNPAG=0

           SET DIR(0)="Y"

           SET DIR("A")="Do you want each "_APCLSORV_" on a separate page"

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)

               GOTO SORT

 +3        SET APCLNPAG=Y

ZIS       ;

DEMO      ;

 +1        DO DEMOCHK^APCLUTL(.APCLDEMO)

 +2        IF APCLDEMO=-1

               GOTO OUTPUT

 +3        SET XBRC="PROC^APCLGV"

           SET XBRP="^APCLGVP"

           SET XBNS="APCL"

           SET XBRX="XIT^APCLGV"

 +4        DO ^XBDBQUE

XIT       ;

 +1        DO ^XBFMK

 +2        DO EN^XBVK("APCL")

           DO EN^XBVK("AMQQ")

 +3        KILL I,J,K,P,X,Y,Z,%,DDH,DIV,DIU,DFN,DIG,DIW

 +4        QUIT 

 +5       ;

PROC      ;EP - entry point for processing

 +1        SET APCLTOT=0

           SET DFN=0

           SET APCLBT=$HOROLOG

 +2        FOR 

               SET DFN=$ORDER(^AUPNVSIT("AA",DFN))

               IF DFN'=+DFN

                   QUIT 

               DO PROC1

 +3        SET APCLET=$HOROLOG

 +4        KILL DFN

 +5        QUIT 

PROC1     ;

 +1        SET APCLR=0

           SET APCLBDO=(9999999-APCLBD)_".9999"

           SET APCLEDO=(9999999-APCLED)

           SET APCLSD=(APCLEDO-1)_".9999"

           SET APCLRCNT=0

 +2        FOR 

               SET APCLSD=$ORDER(^AUPNVSIT("AA",DFN,APCLSD))

               IF APCLSD>APCLBDO!(APCLSD="")

                   QUIT 

               Begin DoDot:1

 +3                SET APCLVIEN=0

                   FOR 

                       SET APCLVIEN=$ORDER(^AUPNVSIT("AA",DFN,APCLSD,APCLVIEN))

                       IF APCLVIEN'=+APCLVIEN

                           QUIT 

                       Begin DoDot:2

 +4                        IF '$PIECE(^AUPNVSIT(APCLVIEN,0),U,9)

                               QUIT 

 +5                        IF $PIECE(^AUPNVSIT(APCLVIEN,0),U,11)

                               QUIT 

 +6                        SET APCLVREC=^AUPNVSIT(APCLVIEN,0)

 +7                        IF $$DEMO^APCLUTL($PIECE(APCLVREC,U,5),$GET(APCLDEMO))

                               QUIT 

 +8                        DO SCREENS

 +9                        IF $DATA(APCLSKIP)

                               QUIT 

 +10      ;COUNT # VISITS

                           SET APCLRCNT=APCLRCNT+1

                       End DoDot:2

 +11               QUIT 

               End DoDot:1

 +12       IF APCLRCNT'<APCLNUM

               Begin DoDot:1

 +13               IF APCLOUT="S"

                       SET ^XTMP("APCLGV",APCLJOB,APCLBTH,"PATIENTS","TEMPLATE",DFN)=""

                       SET APCLTOT=APCLTOT+1

                       QUIT 

 +14               KILL APCLSRT,APCLPRNT

                   SET APCLCRIT=APCLSORT

                   SET APCLX=0

 +15               IF $DATA(^APCLVSTS(APCLSORT,4))

                       XECUTE ^APCLVSTS(APCLSORT,4)

 +16               SET APCLSRT=$GET(APCLPRNT)

                   IF APCLSRT=""

                       SET APCLSRT="??"

 +17               SET ^XTMP("APCLGV",APCLJOB,APCLBTH,"PATIENTS",APCLSRT,DFN)=""

                   SET APCLTOT=APCLTOT+1

               End DoDot:1

 +18       QUIT 

 +19      ;

SCREENS   ;EP

 +1        KILL APCLSKIP

 +2        SET APCLI=0

           FOR 

               SET APCLI=$ORDER(^APCLVRPT(APCLRPT,11,APCLI))

               IF APCLI'=+APCLI!($DATA(APCLSKIP))

                   QUIT 

               Begin DoDot:1

 +3                IF '$PIECE(^APCLVSTS(APCLI,0),U,8)

                       DO SINGLE

                       QUIT 

 +4                DO MULT

 +5                QUIT 

               End DoDot:1

 +6        QUIT 

SINGLE    ;

 +1        KILL X,APCLSPEC

           SET X=""

           SET APCLX=0

 +2        IF $DATA(^APCLVSTS(APCLI,1))

               XECUTE ^(1)

 +3        IF X=""

               SET APCLSKIP=""

               QUIT 

 +4        IF '$DATA(APCLSPEC)

               IF '$DATA(^APCLVRPT(APCLRPT,11,APCLI,11,"B",X))

                   SET APCLSKIP=""

                   QUIT 

 +5        QUIT 

MULT      ;

 +1        KILL APCLFOUN,APCLSKIP,APCLSPEC,X

           SET APCLX=0

           SET X=""

 +2        IF $DATA(^APCLVSTS(APCLI,1))

               XECUTE ^(1)

 +3        IF $ORDER(X(""))=""

               SET APCLSKIP=""

               QUIT 

 +4        IF '$DATA(APCLSPEC)

               SET Y=""

               FOR 

                   SET Y=$ORDER(X(Y))

                   IF Y=""

                       QUIT 

                   IF $DATA(^APCLVRPT(APCLRPT,11,APCLI,11,"B",Y))

                       SET APCLFOUN=""

                       QUIT 

 +5        IF $DATA(APCLSPEC)

               IF $DATA(X)

                   SET APCLFOUN=1

                   QUIT 

 +6        IF '$DATA(APCLFOUN)

               SET APCLSKIP=""

 +7        QUIT