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
