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

APCLVL.m

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