PRCHUPT.m

PRCHUPT ;WISC/AKS-Unposted Dietetic cost report ;

 ;;5.1;IFCAP;;Oct 20, 2000

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

 N PRCHFR,PRCHTO,FR,TO,L,DIC,BY,FLDS,Y,FROM,LASTTO,DIS,PRCF

 S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE"))

 S DIR(0)="F",DIR("?")="This is the valid Fund Control Point."

 S DIR("A")="START WITH FCP",DIR("B")="FIRST" D ^DIR Q:X["^"

 S (FROM,PRCHFR)=Y I Y?1.N S PRCHFR=Y_" "

 I Y="FIRST" S PRCHFR="" K DIR,X

 S (PRCHTO,LASTTO)="" I $G(Y)'="FIRST" D LAST Q:X["^"

PRINT I FROM]LASTTO S PRCHTO=LASTTO

 S FR=","_PRCHFR_",?",TO=","_PRCHTO_",?"

 S L=0,DIC=442,BY="[PRCH UNPOSTED DIETETIC SORT]"

 S DIS(0)="I PRC(""SITE"")=$P($P(^PRC(442,D0,0),U),""-"")&('$P($G(^PRC(442,D0,18)),U,8))"

 S FLDS="[PRCH UNPOSTED DIETETIC PRINT]" D EN1^DIP

 I PRCHFR]"",PRCHTO]"",FROM]LASTTO D LAST Q:X["^"  G PRINT

 QUIT

LAST S DIR(0)="F",DIR("?")="This is the valid Fund Control Point."

 S DIR("A")="GO TO FCP",DIR("B")="LAST" D ^DIR Q:X["^"

 S (LASTTO,PRCHTO)=Y

 I Y?1.N S PRCHTO=Y_"z"

 I Y="LAST" S PRCHTO="" K DIR

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCHUPT   1062     printed  Apr 09, 2024@21:20:53                                                                                                                                                                                                     Page 2

PRCHUPT   ;WISC/AKS-Unposted Dietetic cost report ;

 +1       ;;5.1;IFCAP;;Oct 20, 2000

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

 +3        NEW PRCHFR,PRCHTO,FR,TO,L,DIC,BY,FLDS,Y,FROM,LASTTO,DIS,PRCF

 +4        SET PRCF("X")="S"

           DO ^PRCFSITE

           if '$DATA(PRC("SITE"))

               QUIT 

 +5        SET DIR(0)="F"

           SET DIR("?")="This is the valid Fund Control Point."

 +6        SET DIR("A")="START WITH FCP"

           SET DIR("B")="FIRST"

           DO ^DIR

           if X["^"

               QUIT 

 +7        SET (FROM,PRCHFR)=Y

           IF Y?1.N

               SET PRCHFR=Y_" "

 +8        IF Y="FIRST"

               SET PRCHFR=""

               KILL DIR,X

 +9        SET (PRCHTO,LASTTO)=""

           IF $GET(Y)'="FIRST"

               DO LAST

               if X["^"

                   QUIT 

PRINT      IF FROM]LASTTO

               SET PRCHTO=LASTTO

 +1        SET FR=","_PRCHFR_",?"

           SET TO=","_PRCHTO_",?"

 +2        SET L=0

           SET DIC=442

           SET BY="[PRCH UNPOSTED DIETETIC SORT]"

 +3        SET DIS(0)="I PRC(""SITE"")=$P($P(^PRC(442,D0,0),U),""-"")&('$P($G(^PRC(442,D0,18)),U,8))"

 +4        SET FLDS="[PRCH UNPOSTED DIETETIC PRINT]"

           DO EN1^DIP

 +5        IF PRCHFR]""

               IF PRCHTO]""

                   IF FROM]LASTTO

                       DO LAST

                       if X["^"

                           QUIT 

                       GOTO PRINT

 +6        QUIT 

LAST       SET DIR(0)="F"

           SET DIR("?")="This is the valid Fund Control Point."

 +1        SET DIR("A")="GO TO FCP"

           SET DIR("B")="LAST"

           DO ^DIR

           if X["^"

               QUIT 

 +2        SET (LASTTO,PRCHTO)=Y

 +3        IF Y?1.N

               SET PRCHTO=Y_"z"

 +4        IF Y="LAST"

               SET PRCHTO=""

               KILL DIR

 +5        QUIT