PXRRPRPL.m

PXRRPRPL ;ISL/PKR - Build the Provider list ;11/18/96

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**10,12**;Aug 12, 1996

 ;Build the Provider list based upon the Provider selection criteria.

 ;

 ;=======================================================================

PRV ;Build a list of selected providers.

 N X,Y

 K DTOUT,DUOUT

 S NPL=0

 S DIC=200

 S DIC(0)="AEQMZ"

 S DIC("A")="Select PROVIDER: "

 ;As of April 1996 a determination has been made not to use the provider

 ;key screen.  It has just been commented out because there is a

 ;possibility it may be used in the future.

 ;S DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P($G(^VA(200,+Y,0)),U)))"

 W !

NPRO I NPL'<1 S DIC("A")="Select another PROVIDER: "

 D ^DIC

 I X=(U_U) S DTOUT=1

 I $D(DTOUT) Q

 I +Y'=-1 D  G NPRO

 . S NPL=NPL+1

 . S PXRRPRPL(NPL)=$P(Y,U,2)_U_$P(Y,U,1)

 E  K DIC

 I (NPL=0)&($D(DIRUT)!$D(DUOUT)) Q

 I $D(DUOUT) G PRV

 I (NPL=0)&(+Y=-1) W !,"You must select a provider!" G PRV

 ;

 ;Sort the provider list into ascending order.

 S NPL=$$SORT^PXRRUTIL(NPL,"PXRRPRPL")

 Q

 ;

PXRRPRPL  ;ISL/PKR - Build the Provider list ;11/18/96

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**10,12**;Aug 12, 1996

 +2       ;Build the Provider list based upon the Provider selection criteria.

 +3       ;

 +4       ;=======================================================================

PRV       ;Build a list of selected providers.

 +1        NEW X,Y

 +2        KILL DTOUT,DUOUT

 +3        SET NPL=0

 +4        SET DIC=200

 +5        SET DIC(0)="AEQMZ"

 +6        SET DIC("A")="Select PROVIDER: "

 +7       ;As of April 1996 a determination has been made not to use the provider

 +8       ;key screen.  It has just been commented out because there is a

 +9       ;possibility it may be used in the future.

 +10      ;S DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P($G(^VA(200,+Y,0)),U)))"

 +11       WRITE !

NPRO       IF NPL'<1

               SET DIC("A")="Select another PROVIDER: "

 +1        DO ^DIC

 +2        IF X=(U_U)

               SET DTOUT=1

 +3        IF $DATA(DTOUT)

               QUIT 

 +4        IF +Y'=-1

               Begin DoDot:1

 +5                SET NPL=NPL+1

 +6                SET PXRRPRPL(NPL)=$PIECE(Y,U,2)_U_$PIECE(Y,U,1)

               End DoDot:1

               GOTO NPRO

 +7       IF '$TEST

               KILL DIC

 +8        IF (NPL=0)&($DATA(DIRUT)!$DATA(DUOUT))

               QUIT 

 +9        IF $DATA(DUOUT)

               GOTO PRV

 +10       IF (NPL=0)&(+Y=-1)

               WRITE !,"You must select a provider!"

               GOTO PRV

 +11      ;

 +12      ;Sort the provider list into ascending order.

 +13       SET NPL=$$SORT^PXRRUTIL(NPL,"PXRRPRPL")

 +14       QUIT 

 +15      ;