PXBGPRV3.m

PXBGPRV3 ;ISL/JVS - DOUBLE ?? GATHERING OF CLINIC PROVIDER ;11/5/96  14:23

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**7,11**;Aug 12, 1996

 ;

 ;

 ;

 W !,"THIS IS NOT AN ENTRY POINT" Q

 ;  

 ;

DOUBLE1(FROM) ;--Entry point

 ;

NEW ;

 ;

 N FILE,FIELD,TITLE,HEADING,SUB,CODE,NAME,START,SCREEN,CNT,OK,INDEX,CYCLE

 N TOTAL,PRV,CNT,PXBPMT,SUB2

 ;---SETUP VARIABLES

 S BACK="",INDEX=""

 S START=DATA,SUB=0,SUB2=0

 ;

START1 ;--RECYCLE POINT

 S TITLE="- - C L I N I C    P R O V I D E R S - -"

 ;

 D PRV^PXBUTL2(CLINIC)

 ;

 I '$D(PXBPMT) S TOTAL=0

 I $D(PXBPMT) D

 .S (PRV,CNT)="" F  S PRV=$O(PXBPMT("PRV",PRV)) Q:PRV=""  S CNT=CNT+1 D

 ..S ^TMP("PXBTOTAL",$J,"DILIST","ID",CNT,.01)=PRV

 ..S ^TMP("PXBTOTAL",$J,"DILIST",2,CNT)=$O(PXBPMT("PRV",PRV,0))

 I $D(CNT) S TOTAL=CNT

 ;

 ;--DISPLAY IF NO MATCH FOUND

 I TOTAL=0 W IOCUU,IOCUU,!,IOELEOL D

 .D LOC W !

 .S RESULTS="NO PROVIDERS ARE SET UP FOR THIS CLINIC" W !!!,?(IOM-$L(RESULTS))\2,RESULTS D HELP1^PXBUTL1("CON") R OK:DTIME

 I TOTAL=0 Q TOTAL

 ;

 ;

 ;----DISPLAY LIST TO THE SCREEN

 S HEADING="W !,""ITEM"",?6,""NAME   "",IOINHI,TOTAL,"" MATCHES"",IOINLOW,?30,""       PERSON CLASS IN NEW PERSON FILE"""

LIST ;-DISPLAY LIST TO THE SCREEN

 D LOC W !

 X HEADING

 S SUB=SUB-1

 S NUM=0 F  S SUB=$O(^TMP("PXBTOTAL",$J,"DILIST","ID",SUB)) S NUM=NUM+1 Q:NUM=11  Q:SUB'>0  S SUB2=SUB2+1 D

 .S NAME=$G(^TMP("PXBTOTAL",$J,"DILIST","ID",SUB,.01))

 .S TYPE=$$OCCUP^PXBGPRV($G(^TMP("PXBTOTAL",$J,"DILIST",2,SUB)),+$P($G(^AUPNVSIT(PXBVST,0)),"^",1),"",2) D

 ..N Y,DATE

 ..S Y=+$P($G(^AUPNVSIT(PXBVST,0)),"^",1) X ^DD("DD") S DATE=$P(Y,"@",1)

 ..I +TYPE=-2 S TYPE="*** CLASS not 'ACTIVE' on "_DATE_"***"

 ..I +TYPE=-1 S TYPE=""

 .W !,SUB,?6,$E(NAME,1,20),?30,$E(TYPE,1,45)

 ;

 ;----If There is only one selection go to proper prompting

 I TOTAL=1 G PRMPT2

 ;

PRMPT ;---WRITE PROMPT HERE

 D WIN17^PXBCC(PXBCNT)

 D LOC^PXBCC(15,1)

 W !

 I SUB>0 W !,"Enter '^' to quit"

 E  I TOTAL>10 W !,"               END OF LIST"

 I SUB>0 S DIR("A")="Select a single 'ITEM NUMBER' or 'RETURN' to continue: "

 E  S DIR("A")="Select a single 'ITEM NUMBER' or 'RETURN' to exit: "

 S DIR("?")="Enter ITEM 'No' to select , '^' to quit"

 S DIR(0)="N,A,O^0:"_SUB2_":0^I X'?.1""^"".N K X"

 D ^DIR

 I X="",SUB>0 G LIST

 I X="",SUB'>0 S X="^"

VAL ;-----Set the VAL equal to the value

 S VAL=$G(^TMP("PXBTOTAL",$J,"DILIST",2,X))_"^"_$G(^TMP("PXBTOTAL",$J,"DILIST","ID",X,.01))

EXITNEW ;--EXIT

 K DIR,^TMP("PXBTANA",$J),^TMP("PXBTOTAL",$J)

 K TANA,TOTAL

 Q VAL

 Q

 ;

 ;-----------------SUBROUTINES--------------

BACK ;

 S START=$G(^TMP("PXBTANA",$J,"DILIST",1,1))

 S START("IEN")=$G(^TMP("PXBTANA",$J,"DILIST",2,1))

 Q

FORWARD ;

 S START=$G(^TMP("PXBTANA",$J,"DILIST",1,10))

 S START("IEN")=$G(^TMP("PXBTANA",$J,"DILIST",2,10))

 Q

LOC ;--LOCATE CURSOR

 D LOC^PXBCC(3,1) ;--LOCATE THE CURSOR

 W IOEDEOP ;--CLEAR THE PAGE

 Q

HEAD ;--HEAD

 W !,IOCUU,IOBON,"HELP SCREEN",IOSGR0,?(IOM-$L(TITLE))\2,IOINHI,TITLE,IOINLOW,IOELEOL

 Q

SUB ;--DISPLAY LIST TO THE SCREEN

 I $P(^TMP("PXBTANA",$J,"DILIST",0),"^",1)=0 W !!,"     E N D  O F  L I S T" Q

 X HEADING

 S SUB=0,CNT=0 F  S SUB=$O(^TMP("PXBTANA",$J,"DILIST","ID",SUB)) Q:SUB'>0  S CNT=CNT+1 D

 .S NAME=$G(^TMP("PXBTANA",$J,"DILIST","ID",SUB,.01))

 .W !,SUB,?6,NAME

 Q

SETUP ;-SETP VARIABLES

 S FILE=200,FIELD=.01 D

 S HEADING="W !,""ITEM"",?6,""NAME"""

 Q

PRMPT2 ;-----Yes and No prompt if onlyi choice

 D WIN17^PXBCC(PXBCNT)

 D LOC^PXBCC(15,1)

 S DIR("A")="Is this the correct entry "

 S DIR("B")="YES"

 S DIR(0)="Y"

 D ^DIR

 I Y=0 S X="^"

 I Y=1 S X=1

 G VAL

PXBGPRV3  ;ISL/JVS - DOUBLE ?? GATHERING OF CLINIC PROVIDER ;11/5/96  14:23

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

 +2       ;

 +3       ;

 +4       ;

 +5        WRITE !,"THIS IS NOT AN ENTRY POINT"

           QUIT 

 +6       ;  

 +7       ;

DOUBLE1(FROM) ;--Entry point

 +1       ;

NEW       ;

 +1       ;

 +2        NEW FILE,FIELD,TITLE,HEADING,SUB,CODE,NAME,START,SCREEN,CNT,OK,INDEX,CYCLE

 +3        NEW TOTAL,PRV,CNT,PXBPMT,SUB2

 +4       ;---SETUP VARIABLES

 +5        SET BACK=""

           SET INDEX=""

 +6        SET START=DATA

           SET SUB=0

           SET SUB2=0

 +7       ;

START1    ;--RECYCLE POINT

 +1        SET TITLE="- - C L I N I C    P R O V I D E R S - -"

 +2       ;

 +3        DO PRV^PXBUTL2(CLINIC)

 +4       ;

 +5        IF '$DATA(PXBPMT)

               SET TOTAL=0

 +6        IF $DATA(PXBPMT)

               Begin DoDot:1

 +7                SET (PRV,CNT)=""

                   FOR 

                       SET PRV=$ORDER(PXBPMT("PRV",PRV))

                       IF PRV=""

                           QUIT 

                       SET CNT=CNT+1

                       Begin DoDot:2

 +8                        SET ^TMP("PXBTOTAL",$JOB,"DILIST","ID",CNT,.01)=PRV

 +9                        SET ^TMP("PXBTOTAL",$JOB,"DILIST",2,CNT)=$ORDER(PXBPMT("PRV",PRV,0))

                       End DoDot:2

               End DoDot:1

 +10       IF $DATA(CNT)

               SET TOTAL=CNT

 +11      ;

 +12      ;--DISPLAY IF NO MATCH FOUND

 +13       IF TOTAL=0

               WRITE IOCUU,IOCUU,!,IOELEOL

               Begin DoDot:1

 +14               DO LOC

                   WRITE !

 +15               SET RESULTS="NO PROVIDERS ARE SET UP FOR THIS CLINIC"

                   WRITE !!!,?(IOM-$LENGTH(RESULTS))\2,RESULTS

                   DO HELP1^PXBUTL1("CON")

                   READ OK:DTIME

               End DoDot:1

 +16       IF TOTAL=0

               QUIT TOTAL

 +17      ;

 +18      ;

 +19      ;----DISPLAY LIST TO THE SCREEN

 +20       SET HEADING="W !,""ITEM"",?6,""NAME   "",IOINHI,TOTAL,"" MATCHES"",IOINLOW,?30,""       PERSON CLASS IN NEW PERSON FILE"""

LIST      ;-DISPLAY LIST TO THE SCREEN

 +1        DO LOC

           WRITE !

 +2        XECUTE HEADING

 +3        SET SUB=SUB-1

 +4        SET NUM=0

           FOR 

               SET SUB=$ORDER(^TMP("PXBTOTAL",$JOB,"DILIST","ID",SUB))

               SET NUM=NUM+1

               IF NUM=11

                   QUIT 

               IF SUB'>0

                   QUIT 

               SET SUB2=SUB2+1

               Begin DoDot:1

 +5                SET NAME=$GET(^TMP("PXBTOTAL",$JOB,"DILIST","ID",SUB,.01))

 +6                SET TYPE=$$OCCUP^PXBGPRV($GET(^TMP("PXBTOTAL",$JOB,"DILIST",2,SUB)),+$PIECE($GET(^AUPNVSIT(PXBVST,0)),"^",1),"",2)

                   Begin DoDot:2

 +7                    NEW Y,DATE

 +8                    SET Y=+$PIECE($GET(^AUPNVSIT(PXBVST,0)),"^",1)

                       XECUTE ^DD("DD")

                       SET DATE=$PIECE(Y,"@",1)

 +9                    IF +TYPE=-2

                           SET TYPE="*** CLASS not 'ACTIVE' on "_DATE_"***"

 +10                   IF +TYPE=-1

                           SET TYPE=""

                   End DoDot:2

 +11               WRITE !,SUB,?6,$EXTRACT(NAME,1,20),?30,$EXTRACT(TYPE,1,45)

               End DoDot:1

 +12      ;

 +13      ;----If There is only one selection go to proper prompting

 +14       IF TOTAL=1

               GOTO PRMPT2

 +15      ;

PRMPT     ;---WRITE PROMPT HERE

 +1        DO WIN17^PXBCC(PXBCNT)

 +2        DO LOC^PXBCC(15,1)

 +3        WRITE !

 +4        IF SUB>0

               WRITE !,"Enter '^' to quit"

 +5       IF '$TEST

               IF TOTAL>10

                   WRITE !,"               END OF LIST"

 +6        IF SUB>0

               SET DIR("A")="Select a single 'ITEM NUMBER' or 'RETURN' to continue: "

 +7       IF '$TEST

               SET DIR("A")="Select a single 'ITEM NUMBER' or 'RETURN' to exit: "

 +8        SET DIR("?")="Enter ITEM 'No' to select , '^' to quit"

 +9        SET DIR(0)="N,A,O^0:"_SUB2_":0^I X'?.1""^"".N K X"

 +10       DO ^DIR

 +11       IF X=""

               IF SUB>0

                   GOTO LIST

 +12       IF X=""

               IF SUB'>0

                   SET X="^"

VAL       ;-----Set the VAL equal to the value

 +1        SET VAL=$GET(^TMP("PXBTOTAL",$JOB,"DILIST",2,X))_"^"_$GET(^TMP("PXBTOTAL",$JOB,"DILIST","ID",X,.01))

EXITNEW   ;--EXIT

 +1        KILL DIR,^TMP("PXBTANA",$JOB),^TMP("PXBTOTAL",$JOB)

 +2        KILL TANA,TOTAL

 +3        QUIT VAL

 +4        QUIT 

 +5       ;

 +6       ;-----------------SUBROUTINES--------------

BACK      ;

 +1        SET START=$GET(^TMP("PXBTANA",$JOB,"DILIST",1,1))

 +2        SET START("IEN")=$GET(^TMP("PXBTANA",$JOB,"DILIST",2,1))

 +3        QUIT 

FORWARD   ;

 +1        SET START=$GET(^TMP("PXBTANA",$JOB,"DILIST",1,10))

 +2        SET START("IEN")=$GET(^TMP("PXBTANA",$JOB,"DILIST",2,10))

 +3        QUIT 

LOC       ;--LOCATE CURSOR

 +1       ;--LOCATE THE CURSOR

           DO LOC^PXBCC(3,1)

 +2       ;--CLEAR THE PAGE

           WRITE IOEDEOP

 +3        QUIT 

HEAD      ;--HEAD

 +1        WRITE !,IOCUU,IOBON,"HELP SCREEN",IOSGR0,?(IOM-$LENGTH(TITLE))\2,IOINHI,TITLE,IOINLOW,IOELEOL

 +2        QUIT 

SUB       ;--DISPLAY LIST TO THE SCREEN

 +1        IF $PIECE(^TMP("PXBTANA",$JOB,"DILIST",0),"^",1)=0

               WRITE !!,"     E N D  O F  L I S T"

               QUIT 

 +2        XECUTE HEADING

 +3        SET SUB=0

           SET CNT=0

           FOR 

               SET SUB=$ORDER(^TMP("PXBTANA",$JOB,"DILIST","ID",SUB))

               IF SUB'>0

                   QUIT 

               SET CNT=CNT+1

               Begin DoDot:1

 +4                SET NAME=$GET(^TMP("PXBTANA",$JOB,"DILIST","ID",SUB,.01))

 +5                WRITE !,SUB,?6,NAME

               End DoDot:1

 +6        QUIT 

SETUP     ;-SETP VARIABLES

 +1        SET FILE=200

           SET FIELD=.01

           Begin DoDot:1

           End DoDot:1

 +2        SET HEADING="W !,""ITEM"",?6,""NAME"""

 +3        QUIT 

PRMPT2    ;-----Yes and No prompt if onlyi choice

 +1        DO WIN17^PXBCC(PXBCNT)

 +2        DO LOC^PXBCC(15,1)

 +3        SET DIR("A")="Is this the correct entry "

 +4        SET DIR("B")="YES"

 +5        SET DIR(0)="Y"

 +6        DO ^DIR

 +7        IF Y=0

               SET X="^"

 +8        IF Y=1

               SET X=1

 +9        GOTO VAL