APCLVL ; IHS/CMI/LAB - PCC VISIT GENERAL RETRIEVAL DRIVER ROUTINE ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;visit general retrieval
START ;
I '$D(IOF) D HOME^%ZIS
I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!! Q
I '$G(DUZ) W $C(7),$C(7),!!,"USER NOT SET IN DUZ - NOTIFY SITE MANAGER!!",!! Q
K APCLQUIT ;--- this variable controls whether or not a user terminated input
TYPE ;--- get type of report (patient, date range or search template)
D INFORM^APCLVL01
ORDER ;EP - called from qman
S APCLLMOR=""
W !!,"When the list of items for selection, print and sort are displayed to you"
W !,"in list manager, would you like them sorted alphabetically or in a pre-defined"
W !,"order. The pre-defined order is set by the software and is how the list has"
W !,"historically been displayed."
W !
S DIR(0)="S^P:Predefined Order (the original ordering);A:Alphabetical Order;G:Groups of Related Items",DIR("A")="What order would you like the Items displayed in",DIR("B")="P" KILL DA D ^DIR KILL D
I $D(DIRUT) D XIT Q
S APCLLMOR=Y
;IHS/CMI;GRL redirect if from Qman
I $G(APCLSEAT),$G(AMQQFILE)=9000010 G BD
I $G(APCLSEAT),$G(AMQQFILE)=9000001,APCLTYPE["V" G BD
I $G(APCLSEAT),$G(AMQQFILE)=9000001,APCLTYPE["S" G PS1
;
N ;
S (APCLPCNT,APCLPTCT)=0 ;APCLPTCT -- pt total for # of "V"isits
K APCLTYPE ;--- just in case variable left around
K DIR,X,Y
I APCLPTVS="P" S DIR(0)="S^S:Search Template of Patients;P:Search All Patients;Q:QMAN Search;R:CMS Register of Patients"
I APCLPTVS="V" S DIR(0)="S^P:Search Template of Patients;V:Search Template of Visits;S:Search All Visits;R:CMS Register of Patients",DIR("B")="S"
I APCLPTVS="P" D SETPDIR
S DIR("A")=" Select "_$S(APCLPTVS="P":"Patient ",1:"Visit ")_"List from" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) XIT
S APCLTYPE=APCLPTVS_Y
D @APCLTYPE
Q
PP ;patient lister
D ADD I $D(APCLQUIT) D DEL K APCLQUIT G TYPE
I '$D(APCLCAND) D PP1 Q
D TITLE I $D(APCLQUIT) K APCLQUIT G TYPE
D ZIS
Q
PP1 ;if patient, no prev defined report used
PP11 K ^APCLVRPT(APCLRPT,11) D SCREEN I $D(APCLQUIT) K APCLQUIT D DEL G TYPE
PP12 K ^APCLVRPT(APCLRPT,12) S APCLTCW=0 D COUNT I $D(APCLQUIT) K APCLQUIT G PP11
PP13 D TITLE I $D(APCLQUIT) K APCLQUIT G PP12
D SAVE,ZIS
Q
PS ;--- process report when search template used
Q:$D(APCLQMAN)
D PS0
Q:$D(APCLQUIT)
PS1 ;EP
D ADD I $D(APCLQUIT) G PS
PS12 K ^APCLVRPT(APCLRPT,12) S APCLTCW=0 D COUNT I $D(APCLQUIT) K APCLQUIT G PS
PS13 D TITLE I $D(APCLQUIT) K APCLQUIT G PS12
D ZIS
Q
PS0 ;
S DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)" S DIC="^DIBT(",DIC("A")="Enter Patient SEARCH TEMPLATE name: ",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DICR
I Y=-1 S APCLQUIT="" Q
S APCLSEAT=+Y
Q
PQ ;qman
K APCLQUIT
S APCLQMAN=""
PQ0 ;
W !
S DIR(0)="F^2:30",DIR("A")="Enter a NAME for the SEARCH TEMPLATE QMAN will create" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
S AMQQEN3=Y
I $D(^DIBT("B",Y)) W !!,"That SEARCH TEMPLATE already exists!!" D Q:$D(APCLQUIT)
.S DIR(0)="Y",DIR("A")="Do you want to overlay that template",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
.I $D(DIRUT) S APCLQUIT=1 Q
.I Y=0 S APCLQUIT=1
.Q
S AMQQND=1
D EN3^AMQQ
I AMQQEN3=-1 S APCLQUIT=1 Q
S APCLSEAT=AMQQEN3,APCLTYPE="PS" G PS1
Q
PR ;get cms register and statuses
S APCLCMSR="",APCLCMSS=""
W !
S DIC="^ACM(41.1,",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Register: " D ^DIC
I Y=-1 W !,"No register selected." S APCLQUIT=1 Q
I '$D(^ACM(41.1,+Y,"AU",DUZ)) W !!,"You are not an authorized user of the ",$P(^ACM(41.1,+Y,0),U)," register" G PR
S APCLCMSR=+Y
PRSTAT ;get status
K APCLCMSS
S DIR(0)="Y",DIR("A")="Do you want to select register patients with a particular status",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) S APCLQUIT=1 Q
I Y=0 K APCLCMSS G PS1
PRSTAT1 ;which status
S DIR(0)="9002241,1O",DIR("A")="Which status" KILL DA D ^DIR KILL DIR
I $D(DIRUT) Q
S APCLCMSS(Y)=""
G PS1
VV ;visit/visit search template
W ! S DIC("S")="I $P(^(0),U,4)=9000010" S DIC="^DIBT(",DIC("A")="Enter Visit SEARCH TEMPLATE name: ",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DICR
I Y=-1 S APCLQUIT="" Q
S APCLSEAT=+Y
G VS
Q
VP ;visit/pt search template
W ! S DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)" S DIC="^DIBT(",DIC("A")="Enter Patient SEARCH TEMPLATE name: ",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DICR
I Y=-1 S APCLQUIT="" Q
S APCLSEAT=+Y
G VS
Q
VR ;get cms register and statuses
S APCLCMSR="",APCLCMSS=""
W !
S DIC="^ACM(41.1,",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Register: " D ^DIC
I Y=-1 W !,"No register selected." S APCLQUIT=1 Q
I '$D(^ACM(41.1,+Y,"AU",DUZ)) W !!,"You are not an authorized user of the ",$P(^ACM(41.1,APCLCMSR,0),U)," register" G PR
S APCLCMSR=+Y
VRSTAT ;get status
K APCLCMSS
S DIR(0)="Y",DIR("A")="Do you want to select register patients with a particular status",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) S APCLQUIT=1 Q
I Y=0 K APCLCMSS G VS
VRSTAT1 ;which status
S DIR(0)="9002241,1O",DIR("A")="Which status" KILL DA D ^DIR KILL DIR
I $D(DIRUT) Q
S APCLCMSS(Y)=""
G VS
VS ;
GETDATES ;
S APCLLHDR="DATE RANGE SELECTION" W !!?((80-$L(APCLLHDR))/2),APCLLHDR
W !!,"This is a required response. Remember, if you are using a Search Template of",!,"Visits, the Date Range entered here must correspond to the date range"
W !,"used to generate the template or be a subset of that date range.",!
BD ;EP - CALLED FROM QMAN get beginning date
W ! K DIR,X,Y S DIR(0)="D^:DT:EP",DIR("A")="Enter Beginning Visit Date for search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) D DEL G TYPE
S APCLBD=Y
ED ;get ending date
W ! K DIR,X,Y S DIR(0)="DA^"_APCLBD_":DT:EP",DIR("A")="Enter Ending Visit Date for search: " D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
G:Y="" BD
S APCLED=Y
S X1=APCLBD,X2=-1 D C^%DTC S APCLD=X S Y=APCLBD D DD^%DT S APCLBDD=Y S Y=APCLED D DD^%DT S APCLEDD=Y
D ADD I $D(APCLQUIT) D DEL K APCLQUIT G VS
I '$D(APCLCAND) D D1 Q
D TITLE I $D(APCLQUIT) K APCLQUIT G TYPE
D ZIS
Q
D1 ;if visit, no prev defined report used
D11 K ^APCLVRPT(APCLRPT,11) D SCREEN I $D(APCLQUIT) K APCLQUIT D DEL G VS
D12 K ^APCLVRPT(APCLRPT,12) S APCLTCW=0 D COUNT I $D(APCLQUIT) K APCLQUIT G D11
D13 D TITLE I $D(APCLQUIT) K APCLQUIT G D12
D SAVE,ZIS
Q
SCREEN ;
S APCLCNTL="S"
D ^APCLVL4
Q
COUNT ;count only or detailed report
D COUNT^APCLVL3
Q
TITLE ;
D TITLE^APCLVL3
Q
SAVE ;
D SAVE^APCLVL3
Q
ZIS ;call to XBDBQUE
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G XIT
K APCLOPT
I 'APCLTCW S APCLTCW=IOM
S APCLDONE=""
D SHOW^APCLVLS,SHOWP^APCLVLS,SHOWR^APCLVLS
D XIT1
I $G(APCLBQC)=1 Q
I APCLCTYP="D"!(APCLCTYP="S") D
.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) S APCLQUIT="" Q
.S APCLOPT=Y
G:$G(APCLQUIT) XIT
I $G(APCLOPT)="B" D BROWSE,XIT Q
S XBRP="^APCLVLP",XBRC="^APCLVL1",XBRX="XIT^APCLVL",XBNS="APCL"
D ^XBDBQUE
D XIT
Q
DEL ;EP DELETE LOG ENTRY IF ONE EXISTS AND USER "^" OUT
I $G(APCLRPT),$D(^APCLVRPT(APCLRPT,0)),'$P(^APCLVRPT(APCLRPT,0),U,2) S DIK="^APCLVRPT(",DA=APCLRPT D ^DIK K DIK,DA,DIC
Q
ADD ;
D ADD^APCLVL01
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""^APCLVLP"")"
S XBRC="^APCLVL1",XBRX="XIT^APCLVL",XBIOP=0 D ^XBDBQUE
Q
SETPDIR ;
S DIR("?")="Enter an S, P or Q"
S DIR("?",1)="Selection of 'S' permits you to enter the name of a Search Template of patients"
S DIR("?",2)="which you have previously created using QMAN, Case Management, or Fileman."
S DIR("?",3)=""
S DIR("?",4)="Selection of 'P' will cause the program to search the entire patient database"
S DIR("?",5)="according to the criteria you enter in the patient selection phase of "
S DIR("?",6)="this report."
S DIR("?",7)=""
S DIR("?",8)="Selection of 'Q' will transfer you into QMan to do your selection of patients"
S DIR("?",9)="and return you to this program to create a customized listing and sorting of"
S DIR("?",10)="those patients."
S DIR("?",11)=""
Q
XIT ;
D XIT^APCLVL1
XIT1 ;
D XIT1^APCLVL1
Q
APCLVL ; IHS/CMI/LAB - PCC VISIT GENERAL RETRIEVAL DRIVER ROUTINE ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;visit general retrieval
START ;
+1 IF '$DATA(IOF)
DO HOME^%ZIS
+2 IF '$GET(DUZ(2))
WRITE $CHAR(7),$CHAR(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!!
QUIT
+3 IF '$GET(DUZ)
WRITE $CHAR(7),$CHAR(7),!!,"USER NOT SET IN DUZ - NOTIFY SITE MANAGER!!",!!
QUIT
+4 ;--- this variable controls whether or not a user terminated input
KILL APCLQUIT
TYPE ;--- get type of report (patient, date range or search template)
+1 DO INFORM^APCLVL01
ORDER ;EP - called from qman
+1 SET APCLLMOR=""
+2 WRITE !!,"When the list of items for selection, print and sort are displayed to you"
+3 WRITE !,"in list manager, would you like them sorted alphabetically or in a pre-defined"
+4 WRITE !,"order. The pre-defined order is set by the software and is how the list has"
+5 WRITE !,"historically been displayed."
+6 WRITE !
+7 SET DIR(0)="S^P:Predefined Order (the original ordering);A:Alphabetical Order;G:Groups of Related Items"
SET DIR("A")="What order would you like the Items displayed in"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL D
+8 IF $DATA(DIRUT)
DO XIT
QUIT
+9 SET APCLLMOR=Y
+10 ;IHS/CMI;GRL redirect if from Qman
+11 IF $GET(APCLSEAT)
IF $GET(AMQQFILE)=9000010
GOTO BD
+12 IF $GET(APCLSEAT)
IF $GET(AMQQFILE)=9000001
IF APCLTYPE["V"
GOTO BD
+13 IF $GET(APCLSEAT)
IF $GET(AMQQFILE)=9000001
IF APCLTYPE["S"
GOTO PS1
+14 ;
N ;
+1 ;APCLPTCT -- pt total for # of "V"isits
SET (APCLPCNT,APCLPTCT)=0
+2 ;--- just in case variable left around
KILL APCLTYPE
+3 KILL DIR,X,Y
+4 IF APCLPTVS="P"
SET DIR(0)="S^S:Search Template of Patients;P:Search All Patients;Q:QMAN Search;R:CMS Register of Patients"
+5 IF APCLPTVS="V"
SET DIR(0)="S^P:Search Template of Patients;V:Search Template of Visits;S:Search All Visits;R:CMS Register of Patients"
SET DIR("B")="S"
+6 IF APCLPTVS="P"
DO SETPDIR
+7 SET DIR("A")=" Select "_$SELECT(APCLPTVS="P":"Patient ",1:"Visit ")_"List from"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+8 IF $DATA(DIRUT)
GOTO XIT
+9 SET APCLTYPE=APCLPTVS_Y
+10 DO @APCLTYPE
+11 QUIT
PP ;patient lister
+1 DO ADD
IF $DATA(APCLQUIT)
DO DEL
KILL APCLQUIT
GOTO TYPE
+2 IF '$DATA(APCLCAND)
DO PP1
QUIT
+3 DO TITLE
IF $DATA(APCLQUIT)
KILL APCLQUIT
GOTO TYPE
+4 DO ZIS
+5 QUIT
PP1 ;if patient, no prev defined report used
PP11 KILL ^APCLVRPT(APCLRPT,11)
DO SCREEN
IF $DATA(APCLQUIT)
KILL APCLQUIT
DO DEL
GOTO TYPE
PP12 KILL ^APCLVRPT(APCLRPT,12)
SET APCLTCW=0
DO COUNT
IF $DATA(APCLQUIT)
KILL APCLQUIT
GOTO PP11
PP13 DO TITLE
IF $DATA(APCLQUIT)
KILL APCLQUIT
GOTO PP12
+1 DO SAVE
DO ZIS
+2 QUIT
PS ;--- process report when search template used
+1 IF $DATA(APCLQMAN)
QUIT
+2 DO PS0
+3 IF $DATA(APCLQUIT)
QUIT
PS1 ;EP
+1 DO ADD
IF $DATA(APCLQUIT)
GOTO PS
PS12 KILL ^APCLVRPT(APCLRPT,12)
SET APCLTCW=0
DO COUNT
IF $DATA(APCLQUIT)
KILL APCLQUIT
GOTO PS
PS13 DO TITLE
IF $DATA(APCLQUIT)
KILL APCLQUIT
GOTO PS12
+1 DO ZIS
+2 QUIT
PS0 ;
+1 SET DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)"
SET DIC="^DIBT("
SET DIC("A")="Enter Patient SEARCH TEMPLATE name: "
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA,DR,DICR
+2 IF Y=-1
SET APCLQUIT=""
QUIT
+3 SET APCLSEAT=+Y
+4 QUIT
PQ ;qman
+1 KILL APCLQUIT
+2 SET APCLQMAN=""
PQ0 ;
+1 WRITE !
+2 SET DIR(0)="F^2:30"
SET DIR("A")="Enter a NAME for the SEARCH TEMPLATE QMAN will create"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
QUIT
+4 SET AMQQEN3=Y
+5 IF $DATA(^DIBT("B",Y))
WRITE !!,"That SEARCH TEMPLATE already exists!!"
Begin DoDot:1
+6 SET DIR(0)="Y"
SET DIR("A")="Do you want to overlay that template"
SET DIR("B")="Y"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+7 IF $DATA(DIRUT)
SET APCLQUIT=1
QUIT
+8 IF Y=0
SET APCLQUIT=1
+9 QUIT
End DoDot:1
IF $DATA(APCLQUIT)
QUIT
+10 SET AMQQND=1
+11 DO EN3^AMQQ
+12 IF AMQQEN3=-1
SET APCLQUIT=1
QUIT
+13 SET APCLSEAT=AMQQEN3
SET APCLTYPE="PS"
GOTO PS1
+14 QUIT
PR ;get cms register and statuses
+1 SET APCLCMSR=""
SET APCLCMSS=""
+2 WRITE !
+3 SET DIC="^ACM(41.1,"
SET DIC(0)="AEMQ"
SET DIC("A")="Enter the Name of the Register: "
DO ^DIC
+4 IF Y=-1
WRITE !,"No register selected."
SET APCLQUIT=1
QUIT
+5 IF '$DATA(^ACM(41.1,+Y,"AU",DUZ))
WRITE !!,"You are not an authorized user of the ",$PIECE(^ACM(41.1,+Y,0),U)," register"
GOTO PR
+6 SET APCLCMSR=+Y
PRSTAT ;get status
+1 KILL APCLCMSS
+2 SET DIR(0)="Y"
SET DIR("A")="Do you want to select register patients with a particular status"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
SET APCLQUIT=1
QUIT
+4 IF Y=0
KILL APCLCMSS
GOTO PS1
PRSTAT1 ;which status
+1 SET DIR(0)="9002241,1O"
SET DIR("A")="Which status"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
QUIT
+3 SET APCLCMSS(Y)=""
+4 GOTO PS1
VV ;visit/visit search template
+1 WRITE !
SET DIC("S")="I $P(^(0),U,4)=9000010"
SET DIC="^DIBT("
SET DIC("A")="Enter Visit SEARCH TEMPLATE name: "
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA,DR,DICR
+2 IF Y=-1
SET APCLQUIT=""
QUIT
+3 SET APCLSEAT=+Y
+4 GOTO VS
+5 QUIT
VP ;visit/pt search template
+1 WRITE !
SET DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)"
SET DIC="^DIBT("
SET DIC("A")="Enter Patient SEARCH TEMPLATE name: "
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA,DR,DICR
+2 IF Y=-1
SET APCLQUIT=""
QUIT
+3 SET APCLSEAT=+Y
+4 GOTO VS
+5 QUIT
VR ;get cms register and statuses
+1 SET APCLCMSR=""
SET APCLCMSS=""
+2 WRITE !
+3 SET DIC="^ACM(41.1,"
SET DIC(0)="AEMQ"
SET DIC("A")="Enter the Name of the Register: "
DO ^DIC
+4 IF Y=-1
WRITE !,"No register selected."
SET APCLQUIT=1
QUIT
+5 IF '$DATA(^ACM(41.1,+Y,"AU",DUZ))
WRITE !!,"You are not an authorized user of the ",$PIECE(^ACM(41.1,APCLCMSR,0),U)," register"
GOTO PR
+6 SET APCLCMSR=+Y
VRSTAT ;get status
+1 KILL APCLCMSS
+2 SET DIR(0)="Y"
SET DIR("A")="Do you want to select register patients with a particular status"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
SET APCLQUIT=1
QUIT
+4 IF Y=0
KILL APCLCMSS
GOTO VS
VRSTAT1 ;which status
+1 SET DIR(0)="9002241,1O"
SET DIR("A")="Which status"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
QUIT
+3 SET APCLCMSS(Y)=""
+4 GOTO VS
VS ;
GETDATES ;
+1 SET APCLLHDR="DATE RANGE SELECTION"
WRITE !!?((80-$LENGTH(APCLLHDR))/2),APCLLHDR
+2 WRITE !!,"This is a required response. Remember, if you are using a Search Template of",!,"Visits, the Date Range entered here must correspond to the date range"
+3 WRITE !,"used to generate the template or be a subset of that date range.",!
BD ;EP - CALLED FROM QMAN get beginning date
+1 WRITE !
KILL DIR,X,Y
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter Beginning Visit Date for search"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
DO DEL
GOTO TYPE
+3 SET APCLBD=Y
ED ;get ending date
+1 WRITE !
KILL DIR,X,Y
SET DIR(0)="DA^"_APCLBD_":DT:EP"
SET DIR("A")="Enter Ending Visit Date for search: "
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 IF Y=""
GOTO BD
+4 SET APCLED=Y
+5 SET X1=APCLBD
SET X2=-1
DO C^%DTC
SET APCLD=X
SET Y=APCLBD
DO DD^%DT
SET APCLBDD=Y
SET Y=APCLED
DO DD^%DT
SET APCLEDD=Y
+6 DO ADD
IF $DATA(APCLQUIT)
DO DEL
KILL APCLQUIT
GOTO VS
+7 IF '$DATA(APCLCAND)
DO D1
QUIT
+8 DO TITLE
IF $DATA(APCLQUIT)
KILL APCLQUIT
GOTO TYPE
+9 DO ZIS
+10 QUIT
D1 ;if visit, no prev defined report used
D11 KILL ^APCLVRPT(APCLRPT,11)
DO SCREEN
IF $DATA(APCLQUIT)
KILL APCLQUIT
DO DEL
GOTO VS
D12 KILL ^APCLVRPT(APCLRPT,12)
SET APCLTCW=0
DO COUNT
IF $DATA(APCLQUIT)
KILL APCLQUIT
GOTO D11
D13 DO TITLE
IF $DATA(APCLQUIT)
KILL APCLQUIT
GOTO D12
+1 DO SAVE
DO ZIS
+2 QUIT
SCREEN ;
+1 SET APCLCNTL="S"
+2 DO ^APCLVL4
+3 QUIT
COUNT ;count only or detailed report
+1 DO COUNT^APCLVL3
+2 QUIT
TITLE ;
+1 DO TITLE^APCLVL3
+2 QUIT
SAVE ;
+1 DO SAVE^APCLVL3
+2 QUIT
ZIS ;call to XBDBQUE
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO XIT
+3 KILL APCLOPT
+4 IF 'APCLTCW
SET APCLTCW=IOM
+5 SET APCLDONE=""
+6 DO SHOW^APCLVLS
DO SHOWP^APCLVLS
DO SHOWR^APCLVLS
+7 DO XIT1
+8 IF $GET(APCLBQC)=1
QUIT
+9 IF APCLCTYP="D"!(APCLCTYP="S")
Begin DoDot:1
+10 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
+11 IF $DATA(DIRUT)
SET APCLQUIT=""
QUIT
+12 SET APCLOPT=Y
End DoDot:1
+13 IF $GET(APCLQUIT)
GOTO XIT
+14 IF $GET(APCLOPT)="B"
DO BROWSE
DO XIT
QUIT
+15 SET XBRP="^APCLVLP"
SET XBRC="^APCLVL1"
SET XBRX="XIT^APCLVL"
SET XBNS="APCL"
+16 DO ^XBDBQUE
+17 DO XIT
+18 QUIT
DEL ;EP DELETE LOG ENTRY IF ONE EXISTS AND USER "^" OUT
+1 IF $GET(APCLRPT)
IF $DATA(^APCLVRPT(APCLRPT,0))
IF '$PIECE(^APCLVRPT(APCLRPT,0),U,2)
SET DIK="^APCLVRPT("
SET DA=APCLRPT
DO ^DIK
KILL DIK,DA,DIC
+2 QUIT
ADD ;
+1 DO ADD^APCLVL01
+2 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""^APCLVLP"")"
+2 SET XBRC="^APCLVL1"
SET XBRX="XIT^APCLVL"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
SETPDIR ;
+1 SET DIR("?")="Enter an S, P or Q"
+2 SET DIR("?",1)="Selection of 'S' permits you to enter the name of a Search Template of patients"
+3 SET DIR("?",2)="which you have previously created using QMAN, Case Management, or Fileman."
+4 SET DIR("?",3)=""
+5 SET DIR("?",4)="Selection of 'P' will cause the program to search the entire patient database"
+6 SET DIR("?",5)="according to the criteria you enter in the patient selection phase of "
+7 SET DIR("?",6)="this report."
+8 SET DIR("?",7)=""
+9 SET DIR("?",8)="Selection of 'Q' will transfer you into QMan to do your selection of patients"
+10 SET DIR("?",9)="and return you to this program to create a customized listing and sorting of"
+11 SET DIR("?",10)="those patients."
+12 SET DIR("?",11)=""
+13 QUIT
XIT ;
+1 DO XIT^APCLVL1
XIT1 ;
+1 DO XIT1^APCLVL1
+2 QUIT
