1 | PRCHITM2 ;WOIFO/LKG-NIF Items Descriptions Extract ;9/14/04 16:11
|
---|
2 | V ;;5.1;IFCAP;**63**;Oct 20, 2000
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | PRT ;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
|
---|
18 | PRTX K L,DIC,DIS,FLDS,BY,FR,TO,DHD,DHIT,DIOBEG,DIOEND,DIPCRIT,DTOUT,DUOUT,DIROUT,PRCX
|
---|
19 | Q
|
---|
20 | SORTKEYS() ;Returns sort key string
|
---|
21 | N PRCCNT,PRCX S PRCCNT=0,PRCX=""
|
---|
22 | SORTIN 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"
|
---|
36 | SORTX K DIR,DIRUT,DIROUT,X,Y
|
---|
37 | Q PRCX
|
---|