source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHITM2.m@ 808

Last change on this file since 808 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1PRCHITM2 ;WOIFO/LKG-NIF Items Descriptions Extract ;9/14/04 16:11
2V ;;5.1;IFCAP;**63**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4PRT ;VA FileMan Print Output
5 N PRCTXT S PRCTXT(1)="This option displays item records via FileMan print utilities."
6 S PRCTXT(1,"F")="!!?5"
7 S PRCTXT(2)="It supports up to 5 levels of sort based on displayed fields."
8 S PRCTXT(2,"F")="!?5"
9 D EN^DDIOL(.PRCTXT) K PRCTXT
10 K L,DIC,FLDS,BY,FR,TO,DIS,DHD S DHD="IFCAP ITEM DESCRIPTIONS STATION "_$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
11 S L=0,DIC=441,DIS(0)="I $P($G(^PRC(441,D0,0)),U,15)>0",BY=$$SORTKEYS
12 I $D(DTOUT)!$D(DUOUT) G PRTX
13 S FLDS=".01;C1;""IMF ITEM #"",51;C20;""NIF ITEM #"",14;C40;""EDIT DATE"",16;C60;""INACTIVE FLAG"",""SHORT DESCRIPTION:"";C1;"""",.05;C5;"""",""PRE-NIF SHORT DESCRIPTION:"";C1;"""",52;C5;"""""
14 S FLDS(1)="""DESCRIPTION:"";C1;"""",.1;C5;"""",""PRE-NIF DESCRIPTION:"";C1;"""",50;C5;"""","" "";C1;"""""
15 N PRCTR S PRCTR=0,DHIT="S PRCTR=PRCTR+1",DIOEND="W !!,""Count = "",PRCTR R:$E(IOST,1,2)=""C-"" !,""Press RETURN to continue... "",PRCX:DTIME",DIPCRIT=1
16 S DIOBEG="W:$E(IOST,1,2)=""C-"" @IOF"
17 D EN1^DIP
18PRTX K L,DIC,DIS,FLDS,BY,FR,TO,DHD,DHIT,DIOBEG,DIOEND,DIPCRIT,DTOUT,DUOUT,DIROUT,PRCX
19 Q
20SORTKEYS() ;Returns sort key string
21 N PRCCNT,PRCX S PRCCNT=0,PRCX=""
22SORTIN K DIR,X,Y
23 S DIR(0)="SO^.01:IMF Item# (NUMBER);51:NIF Item#;14:Edit Date (DATE ITEM CREATED);.05:Short Description;52:Pre-NIF Short Description"
24 S DIR("A")=$S(PRCCNT=0:"Sort",1:"Then sort")_" by"
25 S DIR("L",1)=" .01 IMF Item# (NUMBER)"
26 S DIR("L",2)=" 51 NIF Item#"
27 S DIR("L",3)=" 14 Edit Date (DATE ITEM CREATED)"
28 S DIR("L",4)=" .05 Short Description"
29 S DIR("L",5)=" 52 Pre-NIF Short Description"
30 S DIR("L",6)=""
31 S DIR("L")="Press RETURN at the prompt when you have finished selecting sort fields."
32 S DIR("?")="Enter "_$S(PRCCNT<1:"major",1:"minor")_" sort key"
33 D ^DIR I $D(DUOUT)!$D(DTOUT)!$D(DIROUT) S PRCX="" G SORTX
34 I Y'="" S PRCX=PRCX_$S(PRCCNT>0:",",1:"")_Y S PRCCNT=PRCCNT+1 G:PRCCNT<5 SORTIN
35 S:PRCX="" PRCX=".01"
36SORTX K DIR,DIRUT,DIROUT,X,Y
37 Q PRCX
Note: See TracBrowser for help on using the repository browser.