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

ACMRL01.m

Go to the documentation of this file. 
  1. ACMRL01 ; IHS/TUCSON/TMJ - SCREEN LOGIC ; [ 01/07/02  3:43 PM ]
  1.  ;;2.0;ACM CASE MANAGEMENT SYSTEM;**4,8**;JAN 10, 1996
  1.  ;
  1.  ;
  1. INFORM ;PEP-GEN RETRIEVAL INFORMING
  1.  S ACMTCW=0
  1.  W:$D(IOF) @IOF
  1.  S ACMLHDR="CASE MANAGEMENT REGISTER PATIENT GENERAL RETRIEVAL"
  1.  W ?((80-$L(ACMLHDR))/2),ACMLHDR
  1.  W !!!,"This report will produce a listing of Patients on a Register selected by the",!
  1.  W "user.  You will be asked (in three separate steps) to identify your",!
  1.  W "selection criteria; what you wish displayed for each patitent; and the",!
  1.  W "sorting order for your list.  You may save the logic used to produce the report",!
  1.  W "for future use.  If you design a report that is 80 characters or less in width,",!
  1.  W "it can be displayed on your screen or printed.  If your report is 81-132",!
  1.  W "characters wide, it must be printed - and only on a printer capable of",!
  1.  W "producing 132 character lines.",!
  1.  Q
  1.  ;
  1. ADD ;EP
  1.  K ACMCAND
  1.  W !!
  1.  I $D(ACMNCAN) G ADD1
  1.  S DIR(0)="Y",DIR("A")="Do you want to use a PREVIOUSLY DEFINED REPORT",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) S ACMQUIT=1 Q
  1.  I 'Y G ADD1
  1.  S DIC="^ACM(58.8,",DIC("S")="I $P(^(0),U,11)=DUZ&($P(^(0),U,6)=ACMRG)",DIC(0)="AEQ",DIC("A")="REPORT NAME:  ",D="C" D IX^DIC K DIC,DA,DR
  1.  I Y=-1 S ACMQUIT=1 Q
  1.  S ACMRPT=+Y,ACMCAND=1
  1.  ;--- set up sorting and report control variables
  1.  S ACMSORT=$P(^ACM(58.8,ACMRPT,0),U,7),ACMSORV=$P(^(0),U,8),ACMSPAG=$P(^(0),U,4),ACMCTYP=$P(^(0),U,5)
  1.  S X=0 F  S X=$O(^ACM(58.8,ACMRPT,12,X)) Q:X'=+X  S ACMTCW=ACMTCW+$P(^ACM(58.8,ACMRPT,12,X,0),U,2)+2
  1. DATEFIX ;
  1.  ;are any items date items???  if so, ask for date range.
  1.  S ACMX=0 F  S ACMX=$O(^ACM(58.8,ACMRPT,11,ACMX)) Q:ACMX'=+ACMX  I $P(^ACM(58.1,ACMX,0),U,2)="D" D
  1.  .W !!,"The date range defined in this report for ",$P(^ACM(58.1,ACMX,0),U)," is:",!?5,$$FMTE^XLFDT($P($G(^ACM(58.8,ACMRPT,11,ACMX,11,1,0)),U))_" to "_$$FMTE^XLFDT($P($G(^ACM(58.8,ACMRPT,11,ACMX,11,1,0)),U,2))
  1.  .;WOULD THEY LIKE TO CHANGE THIS RANGE
  1.  .S DIR(0)="Y",DIR("A")="Do you wish to modify this date range",DIR("B")="Y" KILL DA D ^DIR KILL DIR
  1.  .Q:$D(DIRUT)
  1.  .Q:'Y
  1.  .;get new bd and ed and file
  1.  .S ACMCRIT=ACMX,ACMTEXT=$P(^ACM(58.1,ACMX,0),U) D D^ACMRL0
  1.  K ACMX,ACMCRIT,ACMTEXT
  1.  Q
  1. ADD1 ;
  1.  ;CREATE REPORT ENTRY IN FILEMAN FILE
  1.  S %H=$H D YX^%DTC S X=$P(^VA(200,DUZ,0),U)_"-"_Y,DIC(0)="L",DIC="^ACM(58.8,",DLAYGO=9002258.8,DIADD=1,DIC("DR")=".06////"_ACMRG_";.11////"_DUZ
  1.  D ^DIC K DIC,DA,DR,DIADD,DLAYGO I Y=-1 W !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!" S ACMQUIT=1 Q
  1.  S ACMRPT=+Y
  1.  K DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
  1.  ;DELETE ALL 11 MULTIPLE HERE
  1.  K ^ACM(58.8,ACMRPT,11)
  1.  Q
  1. PAUSE ;EP
  1.  Q:$E(IOST)'="C"!(IO'=IO(0))
  1.  W ! S DIR(0)="EO",DIR("A")="Hit return to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  Q
  1.  ;
  1. N ;EP
  1.  K ^ACM(58.8,ACMRPT,11,ACMCRIT),^ACM(58.8,ACMRPT,11,"B",ACMCRIT)
  1.  S DIR(0)="FO^1:7",DIR("A")="Enter a Range of numbers (e.g. 5-12,1-1)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I Y="" W !!,"No numeric range entered.  All numerics will be included." Q
  1.  I $D(^ACM(58.1,ACMCRIT,25)) S X=Y X ^(25) I '$D(X),$D(^ACM(58.1,ACMCRIT,26)) W !! X ^(26) G N ;if input tx exists and fails G N
  1.  I '$D(^ACM(58.1,ACMCRIT,25)),Y'?1.3N1"-"1.3N W !!,$C(7),$C(7),"Enter a numeric range in the format nnn-nnn.  E.g. 0-5, 0-99, 5-20." G N
  1.  S ^ACM(58.8,ACMRPT,11,ACMCRIT,0)=ACMCRIT,^ACM(58.8,ACMRPT,11,"B",ACMCRIT,ACMCRIT)=""
  1.  S ACMCNT=0,^ACM(58.8,ACMRPT,11,ACMCRIT,11,0)="^9002258.8110101A^1^1" F X=$P(Y,"-"):1:$P(Y,"-",2) S ACMCNT=ACMCNT+1,^ACM(58.8,ACMRPT,11,ACMCRIT,11,ACMCNT,0)=X,^ACM(58.8,ACMRPT,11,ACMCRIT,11,"B",X,ACMCNT)=""
  1.  S $P(^ACM(58.8,ACMRPT,11,ACMCRIT,11,1,0),U,2)=$P(Y,"-",2)
  1.  Q
  1. F ;EP - free text
  1.  K ^ACM(58.8,ACMRPT,11,ACMCRIT),^ACM(58.8,ACMRPT,11,"B",ACMCRIT)
  1.  S DIR(0)="FO^1:20",DIR("A")="Enter a Range of Characters for Search (e.g. A:B) " D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I Y="" W !!,"No range entered.  All ",ACMTEXT,"  will be included." Q
  1.  I $D(^ACM(58.1,ACMCRIT,21)) S X=Y X ^(21) I '$D(X),$D(^ACM(58.1,ACMCRIT,22)) W !! X ^(22) G F ;if input tx exists and fails G N
  1.  I '$D(^ACM(58.1,ACMCRIT,21)),Y'?1.ANP1":"1.ANP W !!,$C(7),$C(7),"Enter an free text range in the format AAA:AAA.  E.g. 94-01:94-200,CA:CZ, A:Z." G F
  1.  S ^ACM(58.8,ACMRPT,11,ACMCRIT,0)=ACMCRIT,^ACM(58.8,ACMRPT,11,"B",ACMCRIT,ACMCRIT)=""
  1.  S ACMCNT=0,^ACM(58.8,ACMRPT,11,ACMCRIT,11,ACMCNT,0)="^9002258.8110101A^1^1" S ACMCNT=ACMCNT+1,^ACM(58.8,ACMRPT,11,ACMCRIT,11,1,0)=$P(X,":")_U_$P(X,":",2),^ACM(58.8,ACMRPT,11,ACMCRIT,11,"B",$P(X,":"),ACMCNT)=""
  1.  Q
  1. J ;EP;JUST A HIT
  1.  S ^ACM(58.8,ACMRPT,11,ACMCRIT,0)=ACMCRIT,^ACM(58.8,ACMRPT,11,"B",ACMCRIT,ACMCRIT)=""
  1.  S ^ACM(58.8,ACMRPT,11,ACMCRIT,11,1,0)=1,^ACM(58.8,ACMRPT,11,ACMCRIT,11,"B",1,1)="",^ACM(58.8,ACMRPT,11,ACMCRIT,11,0)="^9002258.8110101A^"_1_"^"_1
  1.  Q
  1. Y ;EP - called from apclvl0
  1.  S DIR(0)="S^1:"_ACMTEXT_";0:NO "_ACMTEXT_"",DIR("A")="Should Patient have",DIR("B")="1" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  Q:$D(DIRUT)
  1.  Q:Y=""
  1.  S ^ACM(58.8,ACMRPT,11,ACMCRIT,0)=ACMCRIT,^ACM(58.8,ACMRPT,11,"B",ACMCRIT,ACMCRIT)=""
  1.  S ^ACM(58.8,ACMRPT,11,ACMCRIT,11,1,0)=Y,^ACM(58.8,ACMRPT,11,ACMCRIT,11,"B",Y,1)="",^ACM(58.8,ACMRPT,11,ACMCRIT,11,0)="^9002258.8110101A^"_1_"^"_1
  1.  Q