PXRMXSU ;SLC/PJH - Reminder Reports DIC Prompts ;01/04/2020
;;2.0;CLINICAL REMINDERS;**4,42**;Feb 04, 2005;Build 245
;
;Called by PXRMXD
;
;Exits from SEL subroutine
QUIT() I $D(DTOUT)!$D(DUOUT) Q 1
;Only one entry allowed
I ONE="D",(CNT>0) Q 1
;Mandatory entry
I Y=-1,(CHECK=3)!(CNT>0) Q 1
;Categories may already contain reminders
I Y=-1,CHECK=2,$D(REMCAT) Q 1
;Otherwise
Q 0
;
;Repeated Prompt using DIC
;-------------------------
SEL(FILE,MODE,CNT,ARRAY,ONE,CHECK) ;
;
; ONE = only allows one entry
; CHECK = number or null - validation of facility
;
N X,Y,ARRAYN
K DIROUT,DIRUT,DTOUT,DUOUT
W !
F D Q:$$QUIT
.S DIC=FILE,DIC(0)=MODE
.; Set up ^DIC("S") for duplicate check
.S DIC("S")="I '$D(ARRAYN(+Y))"
.I CHECK=1 D FACT^PXRMXAP
.I CHECK=2 S DIC("S")=DIC("S")_",'(+$P(^(0),U,6))"
.I CHECK=3 S DIC("S")=DIC("S")_",$$OK^PXRMXS1(+Y)"
.I CHECK=4 S DIC("S")=DIC("S")_",$P($G(^PXRMXP(810.5,+Y,30,0)),U,3)>0"
.I CHECK=5 S DIC("S")=DIC("S")_",$P($G(^OR(100.21,+Y,10,0)),U,3)>0"
.I CNT>0 S DIC("A")=LIT
.D ^DIC
.I X=(U_U) S DTOUT=1
.I $D(DTOUT)!$D(DUOUT) Q
.I +Y'=-1 D Q
..I $D(ARRAYN(+Y)) W !,"Error - Duplicate entry" Q
..S CNT=CNT+1,ARRAY(CNT)=Y_U_Y(0,0)_U_$P(Y(0),U,3)
..S ARRAYN(+Y)=""
.I CNT=0,'$$QUIT W !,LIT1
.K DIC
Q
;
;---
CATCHECK(NCAT,REMCAT) ;Check the selected categories for problems.
N CATIEN,CATOK,DEFIEN,IND,JND,TEST
S CATOK=1
F IND=1:1:NCAT D
. S CATIEN=$P(REMCAT(IND),U,1)
. S JND=0
. F S JND=+$O(^PXRMD(811.7,CATIEN,2,JND)) Q:JND=0 D
.. S TEST=^PXRMD(811.7,CATIEN,2,JND,0)
.. S REMIEN=$P(TEST,U,1)
.. I '$D(^PXD(811.9,REMIEN)) D
... W !!,"Reminder Category: "_$P(^PXRMD(811.7,CATIEN,0),U,1)_" contains a pointer to a reminder that does"
... W !,"not exist on the system, the reminder pointer is ",REMIEN,"."
... S CATOK=0
.;Check sub-categories.
. S JND=0
. F S JND=+$O(^PXRMD(811.7,CATIEN,10,JND)) Q:JND=0 D
.. S SUBCAT(1)=$P(^PXRMD(811.7,CATIEN,10,JND,0),U,1)
.. S CATOK=$$CATCHECK(1,.SUBCAT)
Q CATOK
;---
;
;Establish the LOCATION criteria
LOC(ADEF,BDEF) ;
N X,Y,DIR
LOC0 K DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="S"_U_"HA:All Outpatient Locations;"
S DIR(0)=DIR(0)_"HAI:All Inpatient Locations;"
S DIR(0)=DIR(0)_"HS:Selected Hospital Locations;"
S DIR(0)=DIR(0)_"CA:All Clinic Stops(with encounters);"
S DIR(0)=DIR(0)_"CS:Selected Clinic Stops;"
S DIR(0)=DIR(0)_"GS:Selected Clinic Groups;"
S DIR("A")=ADEF
S DIR("B")=BDEF
S DIR("?")="Select from the codes displayed. For detailed help type ??"
S DIR("??")=U_"D HELP^PXRMXHLP(8)"
D ^DIR K DIR
I $D(DIROUT) S DTOUT=1
I $D(DTOUT)!($D(DUOUT)) Q
S PXRMLCSC=Y_U_Y(0)
;If locations are to be selected individually get the list.
I Y="HS" D HLOC Q:$D(DTOUT) G:$D(DUOUT) LOC0
I Y="CS" D CSTOP Q:$D(DTOUT) G:$D(DUOUT) LOC0
I Y="GS" D CGRP(.PXRMCGRP) Q:$D(DTOUT) G:$D(DUOUT) LOC0
Q
;
;Build a list of hospital locations
HLOC N IEN,SC,X,Y,CHECK
K DTOUT,DUOUT
S NHL=0
S DIC("A")="LOCATION: "
W !
F D Q:$D(DTOUT) Q:$D(DUOUT) Q:(Y=-1)&(NHL>0)
.S DIC="^SC("
.S DIC(0)="AEQMZ"
.I NHL>0 S DIC("A")="Select another LOCATION: "
.D ^DIC
.I X=(U_U) S DTOUT=1
.I $D(DTOUT)!($D(DUOUT)) Q
.I +Y'=-1 D
..S IEN=$P(Y,U,1)
..;Check Facility code
..N FACILITY S FACILITY=$$FACL^PXRMXAP(IEN)
..I FACILITY="" W !,"Location has no facility code" Q
..I '$D(PXRMFACN(FACILITY)) D Q
...W !,"Location has a different facility code" Q
..;Check for duplicates
..I (NHL>0),$$DUP(IEN,.PXRMLCHL,2) W !,"Error - Duplicate entry" Q
..S NHL=NHL+1
..;Get the stop code.
..S X=$P(^SC(IEN,0),U,7)
..S SC="Unknown" I +X>0 S SC=$P(^DIC(40.7,X,0),U,2) ; DBIA #557
..I $L(SC)=0 S SC="Unknown"
..;Save the external form of the name, then IEN, and the stop code.
..S PXRMLCHL(NHL)=$P(Y(0,0),U,1)_U_IEN_U_SC
..;Check for mixed inpatient and outpatient locations
..I (NHL>1),$D(CHECK)=0 D
...Q:'$$LOCN^PXRMXAP(.PXRMLCHL)
...W !,"Inpatient and Outpatient locations have been selected"
...S CHECK="DONE"
.K DIC
.I (NHL=0)&(+Y=-1) W !,"You must select a hospital location!"
;
I $D(DUOUT)!($D(DTOUT)) Q
;Sort the hospital location list into alphabetical order.
S NHL=$$SORT(NHL,"PXRMLCHL",2)
;Build array by IEN
S IC=""
F S IC=$O(PXRMLCHL(IC)) Q:IC'>0 D
.S PXRMLOCN($P(PXRMLCHL(IC),U,2))=IC
Q
;---
FACILITY(SEL) ;Select facility (COPIED EX- PXRR)
N IC,STATION,X,Y,DIC
K DIRUT,DTOUT,DUOUT
S NFAC=0
S DIC("B")=+$P($$SITE^VASITE,U,3)
S DIC("A")="Select FACILITY: "
W !
F D Q:$D(DTOUT) Q:$D(DUOUT) Q:(Y=-1)&(NFAC>0)
.S DIC=4
.S DIC(0)="AEMQZ"
.I NFAC>0 S DIC("A")="Select another FACILITY: "
.D ^DIC
.I X=(U_U) S DTOUT=1
.I '$D(DTOUT),('$D(DUOUT)),+Y'=-1 D
..;Check for duplicates
..I (NFAC>0),$$DUP($P(Y,U,1),.PXRMFAC,1) W !,"Error - Duplicate entry" Q
..S NFAC=NFAC+1,PXRMFAC(NFAC)=Y_U_Y(0,0)
.K DIC
;
I $D(DTOUT)!$D(DUOUT) Q
;;Save the facility names and station.
F IC=1:1:NFAC D
.S X=$P(PXRMFAC(IC),U,1)
.S STATION=$P($G(^DIC(4,X,99)),U,1)
.S PXRMFACN(X)=$P(PXRMFAC(IC),U,2)_U_STATION
;Sort the facility list into alphabetical order.
S NFAC=$$SORT(NFAC,"PXRMFAC",2)
Q
; ---
CGRP(TEMP) ; Clinic Group Selection
N LIT,LIT1,DIC
S DIC("A")="Select CLINIC GROUP: ",NOTM=0
S LIT="Select another CLINIC GROUP: "
S LIT1="You must select a clinic group!"
D SEL(409.67,"AEQMZ",.NOTM,.TEMP,"","")
;Build array by IEN
S NCGRP=0 N IC S IC=""
F S IC=$O(PXRMCGRP(IC)) Q:IC="" D
.S PXRMCGRN($P(PXRMCGRP(IC),U,1))=IC,NCGRP=IC
Q
; ---
LIST(TEMP) ; Patient List
N LIT,LIT1,DIC,NLIST
S DIC("A")="Select REMINDER PATIENT LIST: ",NLIST=0
S DIC("?")="Select a patient list to run the reminder report against."
S LIT="Select another PATIENT LIST: ",LIT1="You must select a list!"
D SEL(810.5,"AEQMZ",.NLIST,.TEMP,"",4)
Q
;
; ---
PCMM(TEMP) ; PCMM teams
N LIT,LIT1,DIC
S DIC("A")="Select PCMM TEAM: ",NOTM=0
S LIT="Select another PCMM TEAM: ",LIT1="You must select a team!"
D SEL(404.51,"AEQMZ",.NOTM,.TEMP,"",1)
Q
; ---
OERR(TEAM) ; OE/RR teams
N LIT,LIT1,DIC
S DIC("A")="Select TEAM: ",NOTM=0
S LIT="Select another TEAM: ",LIT1="You must select a team!"
D SEL(100.21,"AEQMZ",.NOTM,.TEAM,"",5)
Q
; ---
RCAT(REMCAT,REM) ;Reminder Category/Reminder selection
N CAT,DIC,LIT,LIT1,SEQ
S NCAT=0 K REMCAT,REM
;Reminder Category
RCATS I PXRMREP="S" D Q:$D(DUOUT)!$D(DTOUT)
.K REMCAT S NCAT=0
.S DIC("A")="Select a REMINDER CATEGORY: "
.S LIT="Select another REMINDER CATEGORY: ",LIT1=""
.D SEL(811.7,"AEQMZ",.NCAT,.REMCAT,PXRMREP,3)
I '$$CATCHECK(NCAT,.REMCAT) G RCATS
;Individual Reminders
D REM(.REM) Q:$D(DTOUT)
I $D(DUOUT),PXRMREP="S" G RCATS
Q
; ---
REM(REM) ;Reminders selection
N LIT,LIT1,DIC
K REM S NREM=0
S DIC("A")="Select individual REMINDER: "
S LIT="Select another REMINDER: ",LIT1="You must select a reminder!"
D SEL(811.9,"AEQMZ",.NREM,.REM,PXRMREP,2)
Q
; ---
PAT(VAR) ; Patient select
N LIT,LIT1,DIC
S DIC("A")="Select PATIENT: ",NPAT=0
S LIT="Select another PATIENT: ",LIT1="You must select a patient!"
D SEL(2,"AEQMZ",.NPAT,.VAR,"","")
;Sort the patient list into ascending order.
S NPAT=$$SORT(NPAT,"VAR")
Q
; ---
PROV(PRV) ;Build a list of selected providers.
N LIT,LIT1,DIC
S DIC("A")="Select PROVIDER: ",NPRV=0
S LIT="Select another PROVIDER: ",LIT1="You must select a provider!"
D SEL(200,"AEQMZ",.NPRV,.PRV,"","")
I $D(DTOUT)!($D(DUOUT)) Q
;Sort the provider list into ascending order.
S NPRV=$$SORT(NPRV,"PRV")
Q
; ---
CSTOP ;Get a list of clinic stop codes.
N LIT,LIT1,DIC,X,Y
K DIROUT,DIRUT,DTOUT,DUOUT
S DIC("A")="Select CLINIC STOP: "
S LIT="Select another CLINIC STOP: "
S LIT1="You must select a clinic stop!"
S NCS=0
W !
F D Q:$D(DTOUT) Q:$D(DUOUT) Q:(Y=-1)&(NCS>0)
.S DIC=40.7,DIC(0)="AEMQZ"
.I NCS>0 S DIC("A")=LIT
.D ^DIC
.I X=(U_U) S DTOUT=1
.I '$D(DTOUT),('$D(DUOUT)) D
..I +Y'=-1 D Q
...S NCS=NCS+1
...;Save the external form of the name, the IEN, and the stop code.
...S PXRMCS(NCS)=$P(Y(0,0),U,1)_U_$P(Y,U,1)_U_$P(Y(0),U,2)
..W:NCS=0 !,LIT1
;Sort the clinic stop list into alphabetical order.
S NCS=$$SORT(NCS,"PXRMCS",2)
;Build array by IEN
S IC=""
F S IC=$O(PXRMCS(IC)) Q:IC="" D
.S PXRMCSN($P(PXRMCS(IC),U,2))=IC
Q
; ---
SORT(N,ARRAY,KEY) ;Sort an ARRAY with N elements
;return the number of unique elements. KEY is the piece of ARRAY on
;which to base the sort. The default is the first piece.
;
K ^TMP($J,"SORT")
I (N'>0)!(N=1) Q N
N IC,IND
I '$D(KEY) S KEY=1
F IC=1:1:N S ^TMP($J,"SORT",$P(@ARRAY@(IC),U,KEY))=@ARRAY@(IC)
S IND=""
F IC=1:1 S IND=$O(^TMP($J,"SORT",IND)) Q:IND="" D
.S @ARRAY@(IC)=^TMP($J,"SORT",IND)
K ^TMP($J,"SORT")
Q IC-1
;
;Check for duplicate entries
DUP(VALUE,ARRAY,PIECE) ;
N IC,DUP
S IC=0,DUP=0
F S IC=$O(ARRAY(IC)) Q:IC="" D Q:DUP
.I $P(ARRAY(IC),U,PIECE)=VALUE S DUP=1
Q DUP
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMXSU 9036 printed Apr 09, 2024@20:49:35 Page 2
PXRMXSU ;SLC/PJH - Reminder Reports DIC Prompts ;01/04/2020
+1 ;;2.0;CLINICAL REMINDERS;**4,42**;Feb 04, 2005;Build 245
+2 ;
+3 ;Called by PXRMXD
+4 ;
+5 ;Exits from SEL subroutine
QUIT() IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+1 ;Only one entry allowed
+2 IF ONE="D"
IF (CNT>0)
QUIT 1
+3 ;Mandatory entry
+4 IF Y=-1
IF (CHECK=3)!(CNT>0)
QUIT 1
+5 ;Categories may already contain reminders
+6 IF Y=-1
IF CHECK=2
IF $DATA(REMCAT)
QUIT 1
+7 ;Otherwise
+8 QUIT 0
+9 ;
+10 ;Repeated Prompt using DIC
+11 ;-------------------------
SEL(FILE,MODE,CNT,ARRAY,ONE,CHECK) ;
+1 ;
+2 ; ONE = only allows one entry
+3 ; CHECK = number or null - validation of facility
+4 ;
+5 NEW X,Y,ARRAYN
+6 KILL DIROUT,DIRUT,DTOUT,DUOUT
+7 WRITE !
+8 FOR
Begin DoDot:1
+9 SET DIC=FILE
SET DIC(0)=MODE
+10 ; Set up ^DIC("S") for duplicate check
+11 SET DIC("S")="I '$D(ARRAYN(+Y))"
+12 IF CHECK=1
DO FACT^PXRMXAP
+13 IF CHECK=2
SET DIC("S")=DIC("S")_",'(+$P(^(0),U,6))"
+14 IF CHECK=3
SET DIC("S")=DIC("S")_",$$OK^PXRMXS1(+Y)"
+15 IF CHECK=4
SET DIC("S")=DIC("S")_",$P($G(^PXRMXP(810.5,+Y,30,0)),U,3)>0"
+16 IF CHECK=5
SET DIC("S")=DIC("S")_",$P($G(^OR(100.21,+Y,10,0)),U,3)>0"
+17 IF CNT>0
SET DIC("A")=LIT
+18 DO ^DIC
+19 IF X=(U_U)
SET DTOUT=1
+20 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+21 IF +Y'=-1
Begin DoDot:2
+22 IF $DATA(ARRAYN(+Y))
WRITE !,"Error - Duplicate entry"
QUIT
+23 SET CNT=CNT+1
SET ARRAY(CNT)=Y_U_Y(0,0)_U_$PIECE(Y(0),U,3)
+24 SET ARRAYN(+Y)=""
End DoDot:2
QUIT
+25 IF CNT=0
IF '$$QUIT
WRITE !,LIT1
+26 KILL DIC
End DoDot:1
if $$QUIT
QUIT
+27 QUIT
+28 ;
+29 ;---
CATCHECK(NCAT,REMCAT) ;Check the selected categories for problems.
+1 NEW CATIEN,CATOK,DEFIEN,IND,JND,TEST
+2 SET CATOK=1
+3 FOR IND=1:1:NCAT
Begin DoDot:1
+4 SET CATIEN=$PIECE(REMCAT(IND),U,1)
+5 SET JND=0
+6 FOR
SET JND=+$ORDER(^PXRMD(811.7,CATIEN,2,JND))
if JND=0
QUIT
Begin DoDot:2
+7 SET TEST=^PXRMD(811.7,CATIEN,2,JND,0)
+8 SET REMIEN=$PIECE(TEST,U,1)
+9 IF '$DATA(^PXD(811.9,REMIEN))
Begin DoDot:3
+10 WRITE !!,"Reminder Category: "_$PIECE(^PXRMD(811.7,CATIEN,0),U,1)_" contains a pointer to a reminder that does"
+11 WRITE !,"not exist on the system, the reminder pointer is ",REMIEN,"."
+12 SET CATOK=0
End DoDot:3
End DoDot:2
+13 ;Check sub-categories.
+14 SET JND=0
+15 FOR
SET JND=+$ORDER(^PXRMD(811.7,CATIEN,10,JND))
if JND=0
QUIT
Begin DoDot:2
+16 SET SUBCAT(1)=$PIECE(^PXRMD(811.7,CATIEN,10,JND,0),U,1)
+17 SET CATOK=$$CATCHECK(1,.SUBCAT)
End DoDot:2
End DoDot:1
+18 QUIT CATOK
+19 ;---
+20 ;
+21 ;Establish the LOCATION criteria
LOC(ADEF,BDEF) ;
+1 NEW X,Y,DIR
LOC0 KILL DIROUT,DIRUT,DTOUT,DUOUT
+1 SET DIR(0)="S"_U_"HA:All Outpatient Locations;"
+2 SET DIR(0)=DIR(0)_"HAI:All Inpatient Locations;"
+3 SET DIR(0)=DIR(0)_"HS:Selected Hospital Locations;"
+4 SET DIR(0)=DIR(0)_"CA:All Clinic Stops(with encounters);"
+5 SET DIR(0)=DIR(0)_"CS:Selected Clinic Stops;"
+6 SET DIR(0)=DIR(0)_"GS:Selected Clinic Groups;"
+7 SET DIR("A")=ADEF
+8 SET DIR("B")=BDEF
+9 SET DIR("?")="Select from the codes displayed. For detailed help type ??"
+10 SET DIR("??")=U_"D HELP^PXRMXHLP(8)"
+11 DO ^DIR
KILL DIR
+12 IF $DATA(DIROUT)
SET DTOUT=1
+13 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+14 SET PXRMLCSC=Y_U_Y(0)
+15 ;If locations are to be selected individually get the list.
+16 IF Y="HS"
DO HLOC
if $DATA(DTOUT)
QUIT
if $DATA(DUOUT)
GOTO LOC0
+17 IF Y="CS"
DO CSTOP
if $DATA(DTOUT)
QUIT
if $DATA(DUOUT)
GOTO LOC0
+18 IF Y="GS"
DO CGRP(.PXRMCGRP)
if $DATA(DTOUT)
QUIT
if $DATA(DUOUT)
GOTO LOC0
+19 QUIT
+20 ;
+21 ;Build a list of hospital locations
HLOC NEW IEN,SC,X,Y,CHECK
+1 KILL DTOUT,DUOUT
+2 SET NHL=0
+3 SET DIC("A")="LOCATION: "
+4 WRITE !
+5 FOR
Begin DoDot:1
+6 SET DIC="^SC("
+7 SET DIC(0)="AEQMZ"
+8 IF NHL>0
SET DIC("A")="Select another LOCATION: "
+9 DO ^DIC
+10 IF X=(U_U)
SET DTOUT=1
+11 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+12 IF +Y'=-1
Begin DoDot:2
+13 SET IEN=$PIECE(Y,U,1)
+14 ;Check Facility code
+15 NEW FACILITY
SET FACILITY=$$FACL^PXRMXAP(IEN)
+16 IF FACILITY=""
WRITE !,"Location has no facility code"
QUIT
+17 IF '$DATA(PXRMFACN(FACILITY))
Begin DoDot:3
+18 WRITE !,"Location has a different facility code"
QUIT
End DoDot:3
QUIT
+19 ;Check for duplicates
+20 IF (NHL>0)
IF $$DUP(IEN,.PXRMLCHL,2)
WRITE !,"Error - Duplicate entry"
QUIT
+21 SET NHL=NHL+1
+22 ;Get the stop code.
+23 SET X=$PIECE(^SC(IEN,0),U,7)
+24 ; DBIA #557
SET SC="Unknown"
IF +X>0
SET SC=$PIECE(^DIC(40.7,X,0),U,2)
+25 IF $LENGTH(SC)=0
SET SC="Unknown"
+26 ;Save the external form of the name, then IEN, and the stop code.
+27 SET PXRMLCHL(NHL)=$PIECE(Y(0,0),U,1)_U_IEN_U_SC
+28 ;Check for mixed inpatient and outpatient locations
+29 IF (NHL>1)
IF $DATA(CHECK)=0
Begin DoDot:3
+30 if '$$LOCN^PXRMXAP(.PXRMLCHL)
QUIT
+31 WRITE !,"Inpatient and Outpatient locations have been selected"
+32 SET CHECK="DONE"
End DoDot:3
End DoDot:2
+33 KILL DIC
+34 IF (NHL=0)&(+Y=-1)
WRITE !,"You must select a hospital location!"
End DoDot:1
if $DATA(DTOUT)
QUIT
if $DATA(DUOUT)
QUIT
if (Y=-1)&(NHL>0)
QUIT
+35 ;
+36 IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+37 ;Sort the hospital location list into alphabetical order.
+38 SET NHL=$$SORT(NHL,"PXRMLCHL",2)
+39 ;Build array by IEN
+40 SET IC=""
+41 FOR
SET IC=$ORDER(PXRMLCHL(IC))
if IC'>0
QUIT
Begin DoDot:1
+42 SET PXRMLOCN($PIECE(PXRMLCHL(IC),U,2))=IC
End DoDot:1
+43 QUIT
+44 ;---
FACILITY(SEL) ;Select facility (COPIED EX- PXRR)
+1 NEW IC,STATION,X,Y,DIC
+2 KILL DIRUT,DTOUT,DUOUT
+3 SET NFAC=0
+4 SET DIC("B")=+$PIECE($$SITE^VASITE,U,3)
+5 SET DIC("A")="Select FACILITY: "
+6 WRITE !
+7 FOR
Begin DoDot:1
+8 SET DIC=4
+9 SET DIC(0)="AEMQZ"
+10 IF NFAC>0
SET DIC("A")="Select another FACILITY: "
+11 DO ^DIC
+12 IF X=(U_U)
SET DTOUT=1
+13 IF '$DATA(DTOUT)
IF ('$DATA(DUOUT))
IF +Y'=-1
Begin DoDot:2
+14 ;Check for duplicates
+15 IF (NFAC>0)
IF $$DUP($PIECE(Y,U,1),.PXRMFAC,1)
WRITE !,"Error - Duplicate entry"
QUIT
+16 SET NFAC=NFAC+1
SET PXRMFAC(NFAC)=Y_U_Y(0,0)
End DoDot:2
+17 KILL DIC
End DoDot:1
if $DATA(DTOUT)
QUIT
if $DATA(DUOUT)
QUIT
if (Y=-1)&(NFAC>0)
QUIT
+18 ;
+19 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+20 ;;Save the facility names and station.
+21 FOR IC=1:1:NFAC
Begin DoDot:1
+22 SET X=$PIECE(PXRMFAC(IC),U,1)
+23 SET STATION=$PIECE($GET(^DIC(4,X,99)),U,1)
+24 SET PXRMFACN(X)=$PIECE(PXRMFAC(IC),U,2)_U_STATION
End DoDot:1
+25 ;Sort the facility list into alphabetical order.
+26 SET NFAC=$$SORT(NFAC,"PXRMFAC",2)
+27 QUIT
+28 ; ---
CGRP(TEMP) ; Clinic Group Selection
+1 NEW LIT,LIT1,DIC
+2 SET DIC("A")="Select CLINIC GROUP: "
SET NOTM=0
+3 SET LIT="Select another CLINIC GROUP: "
+4 SET LIT1="You must select a clinic group!"
+5 DO SEL(409.67,"AEQMZ",.NOTM,.TEMP,"","")
+6 ;Build array by IEN
+7 SET NCGRP=0
NEW IC
SET IC=""
+8 FOR
SET IC=$ORDER(PXRMCGRP(IC))
if IC=""
QUIT
Begin DoDot:1
+9 SET PXRMCGRN($PIECE(PXRMCGRP(IC),U,1))=IC
SET NCGRP=IC
End DoDot:1
+10 QUIT
+11 ; ---
LIST(TEMP) ; Patient List
+1 NEW LIT,LIT1,DIC,NLIST
+2 SET DIC("A")="Select REMINDER PATIENT LIST: "
SET NLIST=0
+3 SET DIC("?")="Select a patient list to run the reminder report against."
+4 SET LIT="Select another PATIENT LIST: "
SET LIT1="You must select a list!"
+5 DO SEL(810.5,"AEQMZ",.NLIST,.TEMP,"",4)
+6 QUIT
+7 ;
+8 ; ---
PCMM(TEMP) ; PCMM teams
+1 NEW LIT,LIT1,DIC
+2 SET DIC("A")="Select PCMM TEAM: "
SET NOTM=0
+3 SET LIT="Select another PCMM TEAM: "
SET LIT1="You must select a team!"
+4 DO SEL(404.51,"AEQMZ",.NOTM,.TEMP,"",1)
+5 QUIT
+6 ; ---
OERR(TEAM) ; OE/RR teams
+1 NEW LIT,LIT1,DIC
+2 SET DIC("A")="Select TEAM: "
SET NOTM=0
+3 SET LIT="Select another TEAM: "
SET LIT1="You must select a team!"
+4 DO SEL(100.21,"AEQMZ",.NOTM,.TEAM,"",5)
+5 QUIT
+6 ; ---
RCAT(REMCAT,REM) ;Reminder Category/Reminder selection
+1 NEW CAT,DIC,LIT,LIT1,SEQ
+2 SET NCAT=0
KILL REMCAT,REM
+3 ;Reminder Category
RCATS IF PXRMREP="S"
Begin DoDot:1
+1 KILL REMCAT
SET NCAT=0
+2 SET DIC("A")="Select a REMINDER CATEGORY: "
+3 SET LIT="Select another REMINDER CATEGORY: "
SET LIT1=""
+4 DO SEL(811.7,"AEQMZ",.NCAT,.REMCAT,PXRMREP,3)
End DoDot:1
if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+5 IF '$$CATCHECK(NCAT,.REMCAT)
GOTO RCATS
+6 ;Individual Reminders
+7 DO REM(.REM)
if $DATA(DTOUT)
QUIT
+8 IF $DATA(DUOUT)
IF PXRMREP="S"
GOTO RCATS
+9 QUIT
+10 ; ---
REM(REM) ;Reminders selection
+1 NEW LIT,LIT1,DIC
+2 KILL REM
SET NREM=0
+3 SET DIC("A")="Select individual REMINDER: "
+4 SET LIT="Select another REMINDER: "
SET LIT1="You must select a reminder!"
+5 DO SEL(811.9,"AEQMZ",.NREM,.REM,PXRMREP,2)
+6 QUIT
+7 ; ---
PAT(VAR) ; Patient select
+1 NEW LIT,LIT1,DIC
+2 SET DIC("A")="Select PATIENT: "
SET NPAT=0
+3 SET LIT="Select another PATIENT: "
SET LIT1="You must select a patient!"
+4 DO SEL(2,"AEQMZ",.NPAT,.VAR,"","")
+5 ;Sort the patient list into ascending order.
+6 SET NPAT=$$SORT(NPAT,"VAR")
+7 QUIT
+8 ; ---
PROV(PRV) ;Build a list of selected providers.
+1 NEW LIT,LIT1,DIC
+2 SET DIC("A")="Select PROVIDER: "
SET NPRV=0
+3 SET LIT="Select another PROVIDER: "
SET LIT1="You must select a provider!"
+4 DO SEL(200,"AEQMZ",.NPRV,.PRV,"","")
+5 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+6 ;Sort the provider list into ascending order.
+7 SET NPRV=$$SORT(NPRV,"PRV")
+8 QUIT
+9 ; ---
CSTOP ;Get a list of clinic stop codes.
+1 NEW LIT,LIT1,DIC,X,Y
+2 KILL DIROUT,DIRUT,DTOUT,DUOUT
+3 SET DIC("A")="Select CLINIC STOP: "
+4 SET LIT="Select another CLINIC STOP: "
+5 SET LIT1="You must select a clinic stop!"
+6 SET NCS=0
+7 WRITE !
+8 FOR
Begin DoDot:1
+9 SET DIC=40.7
SET DIC(0)="AEMQZ"
+10 IF NCS>0
SET DIC("A")=LIT
+11 DO ^DIC
+12 IF X=(U_U)
SET DTOUT=1
+13 IF '$DATA(DTOUT)
IF ('$DATA(DUOUT))
Begin DoDot:2
+14 IF +Y'=-1
Begin DoDot:3
+15 SET NCS=NCS+1
+16 ;Save the external form of the name, the IEN, and the stop code.
+17 SET PXRMCS(NCS)=$PIECE(Y(0,0),U,1)_U_$PIECE(Y,U,1)_U_$PIECE(Y(0),U,2)
End DoDot:3
QUIT
+18 if NCS=0
WRITE !,LIT1
End DoDot:2
End DoDot:1
if $DATA(DTOUT)
QUIT
if $DATA(DUOUT)
QUIT
if (Y=-1)&(NCS>0)
QUIT
+19 ;Sort the clinic stop list into alphabetical order.
+20 SET NCS=$$SORT(NCS,"PXRMCS",2)
+21 ;Build array by IEN
+22 SET IC=""
+23 FOR
SET IC=$ORDER(PXRMCS(IC))
if IC=""
QUIT
Begin DoDot:1
+24 SET PXRMCSN($PIECE(PXRMCS(IC),U,2))=IC
End DoDot:1
+25 QUIT
+26 ; ---
SORT(N,ARRAY,KEY) ;Sort an ARRAY with N elements
+1 ;return the number of unique elements. KEY is the piece of ARRAY on
+2 ;which to base the sort. The default is the first piece.
+3 ;
+4 KILL ^TMP($JOB,"SORT")
+5 IF (N'>0)!(N=1)
QUIT N
+6 NEW IC,IND
+7 IF '$DATA(KEY)
SET KEY=1
+8 FOR IC=1:1:N
SET ^TMP($JOB,"SORT",$PIECE(@ARRAY@(IC),U,KEY))=@ARRAY@(IC)
+9 SET IND=""
+10 FOR IC=1:1
SET IND=$ORDER(^TMP($JOB,"SORT",IND))
if IND=""
QUIT
Begin DoDot:1
+11 SET @ARRAY@(IC)=^TMP($JOB,"SORT",IND)
End DoDot:1
+12 KILL ^TMP($JOB,"SORT")
+13 QUIT IC-1
+14 ;
+15 ;Check for duplicate entries
DUP(VALUE,ARRAY,PIECE) ;
+1 NEW IC,DUP
+2 SET IC=0
SET DUP=0
+3 FOR
SET IC=$ORDER(ARRAY(IC))
if IC=""
QUIT
Begin DoDot:1
+4 IF $PIECE(ARRAY(IC),U,PIECE)=VALUE
SET DUP=1
End DoDot:1
if DUP
QUIT
+5 QUIT DUP
