Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMXSU

PXRMXSU.m

Go to the documentation of this file. 
  1. PXRMXSU ; SLC/PJH - Reminder Reports DIC Prompts;01/06/2006
  1.  ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
  1.  ;
  1.  ;Called by PXRMXD
  1.  ;
  1.  ;Exits from SEL subroutine
  1. QUIT() I $D(DTOUT)!$D(DUOUT) Q 1
  1.  ;Only one entry allowed
  1.  I ONE="D",(CNT>0) Q 1
  1.  ;Mandatory entry
  1.  I Y=-1,(CHECK=3)!(CNT>0) Q 1
  1.  ;Categories may already contain reminders
  1.  I Y=-1,CHECK=2,$D(REMCAT) Q 1
  1.  ;Otherwise
  1.  Q 0
  1.  ;
  1.  ;Repeated Prompt using DIC
  1.  ;-------------------------
  1. SEL(FILE,MODE,CNT,ARRAY,ONE,CHECK) ;
  1.  ;
  1.  ; ONE   = only allows one entry
  1.  ; CHECK = number or null - validation of facility
  1.  ;
  1.  N X,Y,ARRAYN
  1.  K DIROUT,DIRUT,DTOUT,DUOUT
  1.  W !
  1.  F  D  Q:$$QUIT
  1.  .S DIC=FILE,DIC(0)=MODE
  1.  .; Set up ^DIC("S") for duplicate check
  1.  .S DIC("S")="I '$D(ARRAYN(+Y))"
  1.  .I CHECK=1 D FACT^PXRMXAP
  1.  .I CHECK=2 S DIC("S")=DIC("S")_",'(+$P(^(0),U,6))"
  1.  .I CHECK=3 S DIC("S")=DIC("S")_",$$OK^PXRMXS1(+Y)"
  1.  .I CHECK=4 S DIC("S")=DIC("S")_",$P($G(^PXRMXP(810.5,+Y,30,0)),U,3)>0"
  1.  .I CHECK=5 S DIC("S")=DIC("S")_",$P($G(^OR(100.21,+Y,10,0)),U,3)>0"
  1.  .I CNT>0 S DIC("A")=LIT
  1.  .D ^DIC
  1.  .I X=(U_U) S DTOUT=1
  1.  .I $D(DTOUT)!$D(DUOUT) Q
  1.  .I +Y'=-1 D  Q
  1.  ..I $D(ARRAYN(+Y)) W !,"Error - Duplicate entry" Q
  1.  ..S CNT=CNT+1,ARRAY(CNT)=Y_U_Y(0,0)_U_$P(Y(0),U,3)
  1.  ..S ARRAYN(+Y)=""
  1.  .I CNT=0,'$$QUIT W !,LIT1
  1.  .K DIC
  1.  Q
  1.  ;
  1.  ;Establish the LOCATION criteria
  1. LOC(ADEF,BDEF) ;
  1.  N X,Y,DIR
  1. LOC0 K DIROUT,DIRUT,DTOUT,DUOUT
  1.  S DIR(0)="S"_U_"HA:All Outpatient Locations;"
  1.  S DIR(0)=DIR(0)_"HAI:All Inpatient Locations;"
  1.  S DIR(0)=DIR(0)_"HS:Selected Hospital Locations;"
  1.  S DIR(0)=DIR(0)_"CA:All Clinic Stops(with encounters);"
  1.  S DIR(0)=DIR(0)_"CS:Selected Clinic Stops;"
  1.  S DIR(0)=DIR(0)_"GS:Selected Clinic Groups;"
  1.  S DIR("A")=ADEF
  1.  S DIR("B")=BDEF
  1.  S DIR("?")="Select from the codes displayed. For detailed help type ??"
  1.  S DIR("??")=U_"D HELP^PXRMXHLP(8)"
  1.  D ^DIR K DIR
  1.  I $D(DIROUT) S DTOUT=1
  1.  I $D(DTOUT)!($D(DUOUT)) Q
  1.  S PXRMLCSC=Y_U_Y(0)
  1.  ;If locations are to be selected individually get the list.
  1.  I Y="HS" D HLOC Q:$D(DTOUT)  G:$D(DUOUT) LOC0
  1.  I Y="CS" D CSTOP Q:$D(DTOUT)  G:$D(DUOUT) LOC0
  1.  I Y="GS" D CGRP(.PXRMCGRP) Q:$D(DTOUT)  G:$D(DUOUT) LOC0
  1.  Q
  1.  ;
  1.  ;Build a list of hospital locations
  1. HLOC N IEN,SC,X,Y,CHECK
  1.  K DTOUT,DUOUT
  1.  S NHL=0
  1.  S DIC("A")="LOCATION: "
  1.  W !
  1.  F  D  Q:$D(DTOUT)  Q:$D(DUOUT)  Q:(Y=-1)&(NHL>0)
  1.  .S DIC="^SC("
  1.  .S DIC(0)="AEQMZ"
  1.  .I NHL>0 S DIC("A")="Select another LOCATION: "
  1.  .D ^DIC
  1.  .I X=(U_U) S DTOUT=1
  1.  .I $D(DTOUT)!($D(DUOUT)) Q
  1.  .I +Y'=-1 D
  1.  ..S IEN=$P(Y,U,1)
  1.  ..;Check Facility code
  1.  ..N FACILITY S FACILITY=$$FACL^PXRMXAP(IEN)
  1.  ..I FACILITY="" W !,"Location has no facility code" Q
  1.  ..I '$D(PXRMFACN(FACILITY)) D  Q
  1.  ...W !,"Location has a different facility code" Q
  1.  ..;Check for duplicates
  1.  ..I (NHL>0),$$DUP(IEN,.PXRMLCHL,2) W !,"Error - Duplicate entry" Q
  1.  ..S NHL=NHL+1
  1.  ..;Get the stop code.
  1.  ..S X=$P(^SC(IEN,0),U,7)
  1.  ..S SC="Unknown" I +X>0 S SC=$P(^DIC(40.7,X,0),U,2) ; DBIA #557
  1.  ..I $L(SC)=0 S SC="Unknown"
  1.  ..;Save the external form of the name, then IEN, and the stop code.
  1.  ..S PXRMLCHL(NHL)=$P(Y(0,0),U,1)_U_IEN_U_SC
  1.  ..;Check for mixed inpatient and outpatient locations
  1.  ..I (NHL>1),$D(CHECK)=0 D
  1.  ...Q:'$$LOCN^PXRMXAP(.PXRMLCHL)
  1.  ...W !,"Inpatient and Outpatient locations have been selected"
  1.  ...S CHECK="DONE"
  1.  .K DIC
  1.  .I (NHL=0)&(+Y=-1) W !,"You must select a hospital location!"
  1.  ;
  1.  I $D(DUOUT)!($D(DTOUT)) Q
  1.  ;Sort the hospital location list into alphabetical order.
  1.  S NHL=$$SORT(NHL,"PXRMLCHL",2)
  1.  ;Build array by IEN
  1.  S IC=""
  1.  F  S IC=$O(PXRMLCHL(IC)) Q:IC'>0  D
  1.  .S PXRMLOCN($P(PXRMLCHL(IC),U,2))=IC
  1.  Q
  1.  ;---
  1. FACILITY(SEL) ;Select facility (COPIED EX- PXRR)
  1.  N IC,STATION,X,Y,DIC
  1.  K DIRUT,DTOUT,DUOUT
  1.  S NFAC=0
  1.  S DIC("B")=+$P($$SITE^VASITE,U,3)
  1.  S DIC("A")="Select FACILITY: "
  1.  W !
  1.  F  D  Q:$D(DTOUT)  Q:$D(DUOUT)  Q:(Y=-1)&(NFAC>0)
  1.  .S DIC=4
  1.  .S DIC(0)="AEMQZ"
  1.  .I NFAC>0 S DIC("A")="Select another FACILITY: "
  1.  .D ^DIC
  1.  .I X=(U_U) S DTOUT=1
  1.  .I '$D(DTOUT),('$D(DUOUT)),+Y'=-1 D
  1.  ..;Check for duplicates
  1.  ..I (NFAC>0),$$DUP($P(Y,U,1),.PXRMFAC,1) W !,"Error - Duplicate entry" Q
  1.  ..S NFAC=NFAC+1,PXRMFAC(NFAC)=Y_U_Y(0,0)
  1.  .K DIC
  1.  ;
  1.  I $D(DTOUT)!$D(DUOUT) Q
  1.  ;;Save the facility names and station.
  1.  F IC=1:1:NFAC D
  1.  .S X=$P(PXRMFAC(IC),U,1)
  1.  .S STATION=$P($G(^DIC(4,X,99)),U,1)
  1.  .S PXRMFACN(X)=$P(PXRMFAC(IC),U,2)_U_STATION
  1.  ;Sort the facility list into alphabetical order.
  1.  S NFAC=$$SORT(NFAC,"PXRMFAC",2)
  1.  Q
  1.  ; ---
  1. CGRP(TEMP) ; Clinic Group Selection
  1.  N LIT,LIT1,DIC
  1.  S DIC("A")="Select CLINIC GROUP: ",NOTM=0
  1.  S LIT="Select another CLINIC GROUP: "
  1.  S LIT1="You must select a clinic group!"
  1.  D SEL(409.67,"AEQMZ",.NOTM,.TEMP,"","")
  1.  ;Build array by IEN
  1.  S NCGRP=0 N IC S IC=""
  1.  F  S IC=$O(PXRMCGRP(IC)) Q:IC=""  D
  1.  .S PXRMCGRN($P(PXRMCGRP(IC),U,1))=IC,NCGRP=IC
  1.  Q
  1.  ; ---
  1. LIST(TEMP) ; Patient List
  1.  N LIT,LIT1,DIC,NLIST
  1.  S DIC("A")="Select REMINDER PATIENT LIST: ",NLIST=0
  1.  S DIC("?")="Select a patient list to run the reminder report against."
  1.  S LIT="Select another PATIENT LIST: ",LIT1="You must select a list!"
  1.  D SEL(810.5,"AEQMZ",.NLIST,.TEMP,"",4)
  1.  Q
  1.  ;
  1.  ; ---
  1. PCMM(TEMP) ; PCMM teams
  1.  N LIT,LIT1,DIC
  1.  S DIC("A")="Select PCMM TEAM: ",NOTM=0
  1.  S LIT="Select another PCMM TEAM: ",LIT1="You must select a team!"
  1.  D SEL(404.51,"AEQMZ",.NOTM,.TEMP,"",1)
  1.  Q
  1.  ; ---
  1. OERR(TEAM) ; OE/RR teams
  1.  N LIT,LIT1,DIC
  1.  S DIC("A")="Select TEAM: ",NOTM=0
  1.  S LIT="Select another TEAM: ",LIT1="You must select a team!"
  1.  D SEL(100.21,"AEQMZ",.NOTM,.TEAM,"",5)
  1.  Q
  1.  ; ---
  1. RCAT(REMCAT,REM) ;Reminder Category/Reminder selection
  1.  N CAT,DIC,LIT,LIT1,SEQ
  1.  S NCAT=0 K REMCAT,REM
  1.  ;Reminder Category
  1. RCATS I PXRMREP="S" D  Q:$D(DUOUT)!$D(DTOUT)
  1.  .K REMCAT S NCAT=0
  1.  .S DIC("A")="Select a REMINDER CATEGORY: "
  1.  .S LIT="Select another REMINDER CATEGORY: ",LIT1=""
  1.  .D SEL(811.7,"AEQMZ",.NCAT,.REMCAT,PXRMREP,3)
  1.  ;Individual Reminders
  1.  D REM(.REM) Q:$D(DTOUT)
  1.  I $D(DUOUT),PXRMREP="S" G RCATS
  1.  Q
  1.  ; ---
  1. REM(REM) ;Reminders selection
  1.  N LIT,LIT1,DIC
  1.  K REM S NREM=0
  1.  S DIC("A")="Select individual REMINDER: "
  1.  S LIT="Select another REMINDER: ",LIT1="You must select a reminder!"
  1.  D SEL(811.9,"AEQMZ",.NREM,.REM,PXRMREP,2)
  1.  Q
  1.  ; ---
  1. PAT(VAR) ; Patient select
  1.  N LIT,LIT1,DIC
  1.  S DIC("A")="Select PATIENT: ",NPAT=0
  1.  S LIT="Select another PATIENT: ",LIT1="You must select a patient!"
  1.  D SEL(2,"AEQMZ",.NPAT,.VAR,"","")
  1.  ;Sort the patient list into ascending order.
  1.  S NPAT=$$SORT(NPAT,"VAR")
  1.  Q
  1.  ; ---
  1. PROV(PRV) ;Build a list of selected providers.
  1.  N LIT,LIT1,DIC
  1.  S DIC("A")="Select PROVIDER: ",NPRV=0
  1.  S LIT="Select another PROVIDER: ",LIT1="You must select a provider!"
  1.  D SEL(200,"AEQMZ",.NPRV,.PRV,"","")
  1.  I $D(DTOUT)!($D(DUOUT)) Q
  1.  ;Sort the provider list into ascending order.
  1.  S NPRV=$$SORT(NPRV,"PRV")
  1.  Q
  1.  ; ---
  1. CSTOP ;Get a list of clinic stop codes.
  1.  N LIT,LIT1,DIC,X,Y
  1.  K DIROUT,DIRUT,DTOUT,DUOUT
  1.  S DIC("A")="Select CLINIC STOP: "
  1.  S LIT="Select another CLINIC STOP: "
  1.  S LIT1="You must select a clinic stop!"
  1.  S NCS=0
  1.  W !
  1.  F  D  Q:$D(DTOUT)  Q:$D(DUOUT)  Q:(Y=-1)&(NCS>0)
  1.  .S DIC=40.7,DIC(0)="AEMQZ"
  1.  .I NCS>0 S DIC("A")=LIT
  1.  .D ^DIC
  1.  .I X=(U_U) S DTOUT=1
  1.  .I '$D(DTOUT),('$D(DUOUT)) D
  1.  ..I +Y'=-1 D  Q
  1.  ...S NCS=NCS+1
  1.  ...;Save the external form of the name, the IEN, and the stop code.
  1.  ...S PXRMCS(NCS)=$P(Y(0,0),U,1)_U_$P(Y,U,1)_U_$P(Y(0),U,2)
  1.  ..W:NCS=0 !,LIT1
  1.  ;Sort the clinic stop list into alphabetical order.
  1.  S NCS=$$SORT(NCS,"PXRMCS",2)
  1.  ;Build array by IEN
  1.  S IC=""
  1.  F  S IC=$O(PXRMCS(IC)) Q:IC=""  D
  1.  .S PXRMCSN($P(PXRMCS(IC),U,2))=IC
  1.  Q
  1.  ; ---
  1. SORT(N,ARRAY,KEY)       ;Sort an ARRAY with N elements 
  1.  ;return the number of unique elements.  KEY is the piece of ARRAY on
  1.  ;which to base the sort.  The default is the first piece.
  1.  ;
  1.  K ^TMP($J,"SORT")
  1.  I (N'>0)!(N=1) Q N
  1.  N IC,IND
  1.  I '$D(KEY) S KEY=1
  1.  F IC=1:1:N S ^TMP($J,"SORT",$P(@ARRAY@(IC),U,KEY))=@ARRAY@(IC)
  1.  S IND=""
  1.  F IC=1:1 S IND=$O(^TMP($J,"SORT",IND)) Q:IND=""  D
  1.  .S @ARRAY@(IC)=^TMP($J,"SORT",IND)
  1.  K ^TMP($J,"SORT")
  1.  Q IC-1
  1.  ;
  1.  ;Check for duplicate entries
  1. DUP(VALUE,ARRAY,PIECE) ;
  1.  N IC,DUP
  1.  S IC=0,DUP=0
  1.  F  S IC=$O(ARRAY(IC)) Q:IC=""  D  Q:DUP
  1.  .I $P(ARRAY(IC),U,PIECE)=VALUE S DUP=1
  1.  Q DUP