- 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 ---[H[J[2J[HPRCHUPT 1062 printed Feb 18, 2025@23:37:45 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