PRCEOPN.m

PRCEOPN ;WISC/LDB-LIST OPEN 1358'S ;1/23/98  1230

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

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

OPN ;LIST OF OPEN (INCOMPLETE) 1358'S

 D EN^PRCSUT G W2^PRCSP1B:'$D(PRC("SITE")),EXIT^PRCSP1B:Y<0 S PRCSZZ=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$P(PRC("CP")," ")

 S DHD="1358'S WITH OPEN AUTHORIZATIONS",L=0,DIC="^PRC(424,"

 S FLDS=".01,.05,.1",BY="[PRCEC OPN1358]"

 S DIS(0)="I $P($G(^PRC(424,D0,0)),""-"")=PRC(""SITE""),$P($G(^PRC(424,D0,0)),U,2),+$P($G(^PRC(442,$P(^(0),U,2),0)),U,3)=+PRC(""CP"")"

 S DIS(1)="S PRCSZZ1=$P($G(^PRC(442,$P(^PRC(424,D0,0),U,2),0)),U,12) I $P($P($G(^PRCS(410,PRCSZZ1,0)),U,1),""-"",1,4)=PRCSZZ"

 D EN1^DIP K PRCSZZ,PRCSZZ1,DHD,L,DIC,FLDS,BY,FR,TO Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCEOPN   744     printed  Apr 09, 2024@21:08:23                                                                                                                                                                                                      Page 2

PRCEOPN   ;WISC/LDB-LIST OPEN 1358'S ;1/23/98  1230

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

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

OPN       ;LIST OF OPEN (INCOMPLETE) 1358'S

 +1        DO EN^PRCSUT

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

               GOTO W2^PRCSP1B

           if Y<0

               GOTO EXIT^PRCSP1B

           SET PRCSZZ=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$PIECE(PRC("CP")," ")

 +2        SET DHD="1358'S WITH OPEN AUTHORIZATIONS"

           SET L=0

           SET DIC="^PRC(424,"

 +3        SET FLDS=".01,.05,.1"

           SET BY="[PRCEC OPN1358]"

 +4        SET DIS(0)="I $P($G(^PRC(424,D0,0)),""-"")=PRC(""SITE""),$P($G(^PRC(424,D0,0)),U,2),+$P($G(^PRC(442,$P(^(0),U,2),0)),U,3)=+PRC(""CP"")"

 +5        SET DIS(1)="S PRCSZZ1=$P($G(^PRC(442,$P(^PRC(424,D0,0),U,2),0)),U,12) I $P($P($G(^PRCS(410,PRCSZZ1,0)),U,1),""-"",1,4)=PRCSZZ"

 +6        DO EN1^DIP

           KILL PRCSZZ,PRCSZZ1,DHD,L,DIC,FLDS,BY,FR,TO

           QUIT