PRCHITM2.m

PRCHITM2 ;WOIFO/LKG-NIF Items Descriptions Extract ;9/14/04  16:11

V ;;5.1;IFCAP;**63**;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

PRT ;VA FileMan Print Output

 N PRCTXT S PRCTXT(1)="This option displays item records via FileMan print utilities."

 S PRCTXT(1,"F")="!!?5"

 S PRCTXT(2)="It supports up to 5 levels of sort based on displayed fields."

 S PRCTXT(2,"F")="!?5"

 D EN^DDIOL(.PRCTXT) K PRCTXT

 K L,DIC,FLDS,BY,FR,TO,DIS,DHD S DHD="IFCAP ITEM DESCRIPTIONS STATION "_$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)

 S L=0,DIC=441,DIS(0)="I $P($G(^PRC(441,D0,0)),U,15)>0",BY=$$SORTKEYS

 I $D(DTOUT)!$D(DUOUT) G PRTX

 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;"""""

 S FLDS(1)="""DESCRIPTION:"";C1;"""",.1;C5;"""",""PRE-NIF DESCRIPTION:"";C1;"""",50;C5;"""","" "";C1;"""""

 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

 S DIOBEG="W:$E(IOST,1,2)=""C-"" @IOF"

 D EN1^DIP

PRTX K L,DIC,DIS,FLDS,BY,FR,TO,DHD,DHIT,DIOBEG,DIOEND,DIPCRIT,DTOUT,DUOUT,DIROUT,PRCX

 Q

SORTKEYS() ;Returns sort key string

 N PRCCNT,PRCX S PRCCNT=0,PRCX=""

SORTIN K DIR,X,Y

 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"

 S DIR("A")=$S(PRCCNT=0:"Sort",1:"Then sort")_" by"

 S DIR("L",1)="   .01  IMF Item# (NUMBER)"

 S DIR("L",2)="    51  NIF Item#"

 S DIR("L",3)="    14  Edit Date (DATE ITEM CREATED)"

 S DIR("L",4)="   .05  Short Description"

 S DIR("L",5)="    52  Pre-NIF Short Description"

 S DIR("L",6)=""

 S DIR("L")="Press RETURN at the prompt when you have finished selecting sort fields."

 S DIR("?")="Enter "_$S(PRCCNT<1:"major",1:"minor")_" sort key"

 D ^DIR I $D(DUOUT)!$D(DTOUT)!$D(DIROUT) S PRCX="" G SORTX

 I Y'="" S PRCX=PRCX_$S(PRCCNT>0:",",1:"")_Y S PRCCNT=PRCCNT+1 G:PRCCNT<5 SORTIN

 S:PRCX="" PRCX=".01"

SORTX K DIR,DIRUT,DIROUT,X,Y

 Q PRCX

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCHITM2   2147     printed  Apr 09, 2024@21:06:45                                                                                                                                                                                                    Page 2

PRCHITM2  ;WOIFO/LKG-NIF Items Descriptions Extract ;9/14/04  16:11

V         ;;5.1;IFCAP;**63**;Oct 20, 2000

 +1       ;Per VHA Directive 10-93-142, this routine should not be modified.

PRT       ;VA FileMan Print Output

 +1        NEW PRCTXT

           SET PRCTXT(1)="This option displays item records via FileMan print utilities."

 +2        SET PRCTXT(1,"F")="!!?5"

 +3        SET PRCTXT(2)="It supports up to 5 levels of sort based on displayed fields."

 +4        SET PRCTXT(2,"F")="!?5"

 +5        DO EN^DDIOL(.PRCTXT)

           KILL PRCTXT

 +6        KILL L,DIC,FLDS,BY,FR,TO,DIS,DHD

           SET DHD="IFCAP ITEM DESCRIPTIONS STATION "_$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)

 +7        SET L=0

           SET DIC=441

           SET DIS(0)="I $P($G(^PRC(441,D0,0)),U,15)>0"

           SET BY=$$SORTKEYS

 +8        IF $DATA(DTOUT)!$DATA(DUOUT)

               GOTO PRTX

 +9        SET 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;"""""

 +10       SET FLDS(1)="""DESCRIPTION:"";C1;"""",.1;C5;"""",""PRE-NIF DESCRIPTION:"";C1;"""",50;C5;"""","" "";C1;"""""

 +11       NEW PRCTR

           SET PRCTR=0

           SET DHIT="S PRCTR=PRCTR+1"

           SET DIOEND="W !!,""Count = "",PRCTR R:$E(IOST,1,2)=""C-"" !,""Press RETURN to continue... "",PRCX:DTIME"

           SET DIPCRIT=1

 +12       SET DIOBEG="W:$E(IOST,1,2)=""C-"" @IOF"

 +13       DO EN1^DIP

PRTX       KILL L,DIC,DIS,FLDS,BY,FR,TO,DHD,DHIT,DIOBEG,DIOEND,DIPCRIT,DTOUT,DUOUT,DIROUT,PRCX

 +1        QUIT 

SORTKEYS() ;Returns sort key string

 +1        NEW PRCCNT,PRCX

           SET PRCCNT=0

           SET PRCX=""

SORTIN     KILL DIR,X,Y

 +1        SET DIR(0)="SO^.01:IMF Item# (NUMBER);51:NIF Item#;14:Edit Date (DATE ITEM CREATED);.05:Short Description;52:Pre-NIF Short Description"

 +2        SET DIR("A")=$SELECT(PRCCNT=0:"Sort",1:"Then sort")_" by"

 +3        SET DIR("L",1)="   .01  IMF Item# (NUMBER)"

 +4        SET DIR("L",2)="    51  NIF Item#"

 +5        SET DIR("L",3)="    14  Edit Date (DATE ITEM CREATED)"

 +6        SET DIR("L",4)="   .05  Short Description"

 +7        SET DIR("L",5)="    52  Pre-NIF Short Description"

 +8        SET DIR("L",6)=""

 +9        SET DIR("L")="Press RETURN at the prompt when you have finished selecting sort fields."

 +10       SET DIR("?")="Enter "_$SELECT(PRCCNT<1:"major",1:"minor")_" sort key"

 +11       DO ^DIR

           IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)

               SET PRCX=""

               GOTO SORTX

 +12       IF Y'=""

               SET PRCX=PRCX_$SELECT(PRCCNT>0:",",1:"")_Y

               SET PRCCNT=PRCCNT+1

               if PRCCNT<5

                   GOTO SORTIN

 +13       if PRCX=""

               SET PRCX=".01"

SORTX      KILL DIR,DIRUT,DIROUT,X,Y

 +1        QUIT PRCX