PXBGPRV2.m

PXBGPRV2 ;ISL/JVS - DOUBLE ?? GATHERING OF PROVIDER ; 1/13/01 10:57am

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

 ;

 ;

 ;

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

 ;

DOUBLE(FROM) ;--Entry point

 ;

 ;  WHAT   = The same WHAT as sent in from the API

 ;  FROM   = Exactly which prompt is asking for the list

 ;  SCREEN = Same as the DIC("S") screen used by file man

 ;  START  = The starting point as to what to look up

 ;  

 ;

 N FILE,FIELD,TITLE,HEADING,SUB,CODE,NAME,START,SCREEN,BACK,NUM

 N SCREEN,TEMP,TEMP

 S BACK="",NUM=0,SCREEN=""

 D LOC

 I $D(DIC("S")) S SCREEN=DIC("S")

 ;

START ;--RECYCLE POINT

 ;

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

 ;

 D SETUP

 D LIST^DIC(FILE,"",FIELD,BACK,10,.START,"","","","","^TMP(""PXBTANA"",$J)","^TMP(""PXBTANA"",$J)")

 ;

 D LOC,HEAD,SUB

 ;

PROMPT ;---WRITE PROMPT HERE

 D WIN17^PXBCC(PXBCNT),LOC^PXBCC(15,1)

 I $G(START)'="" W !!,"Enter '^' to quit,  '-' for previous page."

 I $G(START)'="" S DIR("A")="Select a single 'ITEM NUMBER' or 'RETURN' to continue: "

 I $G(START)="" S DIR("A")="Select a single 'ITEM NUMBER' or 'RETURN' to exit: "

 S DIR("?")="Enter ITEM 'No' to select , '^' to quit,  '-' for previous page."

 S DIR(0)="N,A,O^0:10:0^I X'?.1""-"".1""^"".2N!(+X>10) K X"

 D ^DIR

 I X="",$G(START)="" S X="^",DIRUT=1

 I X="-" S BACK="B" D BACK G START

 I X="" S BACK="" D FORWARD G START

 I $G(DIRUT) K DIRUT S VAL="^P" G EXIT

FINISH ;--FINISH SETTING A VARIBLE TO SELECTED ITEM

 ;

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

EXIT ;--EXIT

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

 Q VAL

 ;

DOUBLE1(FROM) ;--Entry point

 ;

NEW ;

 ;

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

 N TOTAL,TEMP,SUB2,VANUMBER,PXBVA

 ;---SETUP VARIABLES

 S BACK="",INDEX="",TOTAL1=0

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

 ;

START1 ;--RECYCLE POINT

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

 S FILE=200

 S FIELD="@;.01"  ; FIELD=.01  TEJ *105 CHANGE PARM 12/14/2000

RELOOK ;----ADJUST THE DATA FOR LOOKUP IF NECESSARY

 I DATA?.AP S START=$O(^VA(200,"B",DATA),-1)

 I DATA?1AP S DATA="*"

 I DATA?1A4N S START=$O(^VA(200,"BS5",DATA),-1) S INDEX="BS5"

 ;----------------

 S SCREEN=""

 D LIST^DIC(FILE,"",FIELD,BACK,"",.START,DATA,INDEX,SCREEN,"","^TMP(""PXBTOTAL"",$J)","^TMP(""PXBTOTAL"",$J)")

 S TOTAL=$P(^TMP("PXBTOTAL",$J,"DILIST",0),"^",1)

 ;-------------VA NUMBER------------------

 S PXBVA=0 F  S PXBVA=$O(^TMP("PXBTOTAL",$J,"DILIST",2,PXBVA)) Q:PXBVA=""  S VANUMBER($G(^TMP("PXBTOTAL",$J,"DILIST",2,PXBVA)))=""

 S START=$O(^VA(200,"PS2",DATA),-1)

 I DATA=+DATA S START=DATA_" "

 F  S START=$O(^VA(200,"PS2",START)) Q:START'[DATA  D

 .Q:$D(VANUMBER($O(^VA(200,"PS2",START,0))))

 .N IEN

 .S TOTAL=TOTAL+1

 .S (IEN,^TMP("PXBTOTAL",$J,"DILIST",2,TOTAL))=$O(^VA(200,"PS2",START,0))

 .S ^TMP("PXBTOTAL",$J,"DILIST","ID",TOTAL,.01)=$P($G(^VA(200,IEN,0)),"^",1)

 ;----------END VA NUMBERS-----------------

 ;

 ;--DISPLAY IF NO MATCH FOUND

 I TOTAL=0 D

 .D WIN17^PXBCC(PXBCNT)

 .I DATA?1AP W ! D HELP^PXBUTL0("CPT4")

 .I DATA'?1AP W ! D HELP^PXBUTL0("PRVM")

 .S ERROR=1,CYCL=1

 I TOTAL=0 Q TOTAL

 ;

 ;

 ;----DISPLAY LIST TO THE SCREEN

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

LIST ;-DISPLAY LIST TO THE SCREEN

 ;---NEW CODE PATCH 11

 N PXBTYPE

 I TOTAL=1 D  I PXBTYPE>0 S X=1 G VAL

 .S PXBTYPE=$$GET^XUA4A72($G(^TMP("PXBTOTAL",$J,"DILIST",2,1)),$P($G(^AUPNVSIT(PXBVST,0)),"^",1))

 ;-----END NEW CODE---

 ;I TOTAL=1 S X=1 G VAL

 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

 .;---CHANGED

 .N NAME,TYPE

 .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))

 I FROM="PL",TOTAL=1 W $G(^TMP("PXBTOTAL",$J,"DILIST","ID",X,.01))

EXITNEW ;--EXIT

 K DIR,^TMP("PXBTOTAL",$J),^TMP("PXBTANA",$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

 N TYPE

 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))

 .S TYPE=$$OCCUP^PXBGPRV($G(^TMP("PXBTANA",$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)

 Q

SETUP ;-SETP VARIABLES

 S FILE=200,FIELD="@;.01"  ; FIELD=.01 TEJ *105 CHANGE PARM 12/14/2000

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

 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

PXBGPRV2  ;ISL/JVS - DOUBLE ?? GATHERING OF PROVIDER ; 1/13/01 10:57am

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

 +2       ;

 +3       ;

 +4       ;

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

           QUIT 

 +6       ;

DOUBLE(FROM) ;--Entry point

 +1       ;

 +2       ;  WHAT   = The same WHAT as sent in from the API

 +3       ;  FROM   = Exactly which prompt is asking for the list

 +4       ;  SCREEN = Same as the DIC("S") screen used by file man

 +5       ;  START  = The starting point as to what to look up

 +6       ;  

 +7       ;

 +8        NEW FILE,FIELD,TITLE,HEADING,SUB,CODE,NAME,START,SCREEN,BACK,NUM

 +9        NEW SCREEN,TEMP,TEMP

 +10       SET BACK=""

           SET NUM=0

           SET SCREEN=""

 +11       DO LOC

 +12       IF $DATA(DIC("S"))

               SET SCREEN=DIC("S")

 +13      ;

START     ;--RECYCLE POINT

 +1       ;

 +2        SET TITLE="- - A L L  P R O V I D E R S - -"

 +3       ;

 +4        DO SETUP

 +5        DO LIST^DIC(FILE,"",FIELD,BACK,10,.START,"","","","","^TMP(""PXBTANA"",$J)","^TMP(""PXBTANA"",$J)")

 +6       ;

 +7        DO LOC

           DO HEAD

           DO SUB

 +8       ;

PROMPT    ;---WRITE PROMPT HERE

 +1        DO WIN17^PXBCC(PXBCNT)

           DO LOC^PXBCC(15,1)

 +2        IF $GET(START)'=""

               WRITE !!,"Enter '^' to quit,  '-' for previous page."

 +3        IF $GET(START)'=""

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

 +4        IF $GET(START)=""

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

 +5        SET DIR("?")="Enter ITEM 'No' to select , '^' to quit,  '-' for previous page."

 +6        SET DIR(0)="N,A,O^0:10:0^I X'?.1""-"".1""^"".2N!(+X>10) K X"

 +7        DO ^DIR

 +8        IF X=""

               IF $GET(START)=""

                   SET X="^"

                   SET DIRUT=1

 +9        IF X="-"

               SET BACK="B"

               DO BACK

               GOTO START

 +10       IF X=""

               SET BACK=""

               DO FORWARD

               GOTO START

 +11       IF $GET(DIRUT)

               KILL DIRUT

               SET VAL="^P"

               GOTO EXIT

FINISH    ;--FINISH SETTING A VARIBLE TO SELECTED ITEM

 +1       ;

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

EXIT      ;--EXIT

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

 +2        QUIT VAL

 +3       ;

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,TEMP,SUB2,VANUMBER,PXBVA

 +4       ;---SETUP VARIABLES

 +5        SET BACK=""

           SET INDEX=""

           SET TOTAL1=0

 +6        SET START=DATA

           SET SUB=0

           SET SUB2=0

 +7       ;

START1    ;--RECYCLE POINT

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

 +2        SET FILE=200

 +3       ; FIELD=.01  TEJ *105 CHANGE PARM 12/14/2000

           SET FIELD="@;.01"

RELOOK    ;----ADJUST THE DATA FOR LOOKUP IF NECESSARY

 +1        IF DATA?.AP

               SET START=$ORDER(^VA(200,"B",DATA),-1)

 +2        IF DATA?1AP

               SET DATA="*"

 +3        IF DATA?1A4N

               SET START=$ORDER(^VA(200,"BS5",DATA),-1)

               SET INDEX="BS5"

 +4       ;----------------

 +5        SET SCREEN=""

 +6        DO LIST^DIC(FILE,"",FIELD,BACK,"",.START,DATA,INDEX,SCREEN,"","^TMP(""PXBTOTAL"",$J)","^TMP(""PXBTOTAL"",$J)")

 +7        SET TOTAL=$PIECE(^TMP("PXBTOTAL",$JOB,"DILIST",0),"^",1)

 +8       ;-------------VA NUMBER------------------

 +9        SET PXBVA=0

           FOR 

               SET PXBVA=$ORDER(^TMP("PXBTOTAL",$JOB,"DILIST",2,PXBVA))

               IF PXBVA=""

                   QUIT 

               SET VANUMBER($GET(^TMP("PXBTOTAL",$JOB,"DILIST",2,PXBVA)))=""

 +10       SET START=$ORDER(^VA(200,"PS2",DATA),-1)

 +11       IF DATA=+DATA

               SET START=DATA_" "

 +12       FOR 

               SET START=$ORDER(^VA(200,"PS2",START))

               IF START'[DATA

                   QUIT 

               Begin DoDot:1

 +13               IF $DATA(VANUMBER($ORDER(^VA(200,"PS2",START,0))))

                       QUIT 

 +14               NEW IEN

 +15               SET TOTAL=TOTAL+1

 +16               SET (IEN,^TMP("PXBTOTAL",$JOB,"DILIST",2,TOTAL))=$ORDER(^VA(200,"PS2",START,0))

 +17               SET ^TMP("PXBTOTAL",$JOB,"DILIST","ID",TOTAL,.01)=$PIECE($GET(^VA(200,IEN,0)),"^",1)

               End DoDot:1

 +18      ;----------END VA NUMBERS-----------------

 +19      ;

 +20      ;--DISPLAY IF NO MATCH FOUND

 +21       IF TOTAL=0

               Begin DoDot:1

 +22               DO WIN17^PXBCC(PXBCNT)

 +23               IF DATA?1AP

                       WRITE !

                       DO HELP^PXBUTL0("CPT4")

 +24               IF DATA'?1AP

                       WRITE !

                       DO HELP^PXBUTL0("PRVM")

 +25               SET ERROR=1

                   SET CYCL=1

               End DoDot:1

 +26       IF TOTAL=0

               QUIT TOTAL

 +27      ;

 +28      ;

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

 +30       SET HEADING="W !,""ITEM"",?6,""NAME"",?30,""PERSON CLASS IN NEW PERSON FILE"""

LIST      ;-DISPLAY LIST TO THE SCREEN

 +1       ;---NEW CODE PATCH 11

 +2        NEW PXBTYPE

 +3        IF TOTAL=1

               Begin DoDot:1

 +4                SET PXBTYPE=$$GET^XUA4A72($GET(^TMP("PXBTOTAL",$JOB,"DILIST",2,1)),$PIECE($GET(^AUPNVSIT(PXBVST,0)),"^",1))

               End DoDot:1

               IF PXBTYPE>0

                   SET X=1

                   GOTO VAL

 +5       ;-----END NEW CODE---

 +6       ;I TOTAL=1 S X=1 G VAL

 +7        DO LOC

           WRITE !

 +8        XECUTE HEADING

 +9        SET SUB=SUB-1

 +10       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

 +11      ;---CHANGED

 +12               NEW NAME,TYPE

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

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

                   Begin DoDot:2

 +15                   NEW Y,DATE

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

                       XECUTE ^DD("DD")

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

 +17                   IF +TYPE=-2

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

 +18                   IF +TYPE=-1

                           SET TYPE=""

                   End DoDot:2

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

               End DoDot:1

 +20      ;----------

 +21      ;

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

 +23       IF TOTAL=1

               GOTO PRMPT2

 +24      ;

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))

 +2        IF FROM="PL"

               IF TOTAL=1

                   WRITE $GET(^TMP("PXBTOTAL",$JOB,"DILIST","ID",X,.01))

EXITNEW   ;--EXIT

 +1        KILL DIR,^TMP("PXBTOTAL",$JOB),^TMP("PXBTANA",$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        NEW TYPE

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

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

               QUIT 

 +3        XECUTE HEADING

 +4        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

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

 +6                SET TYPE=$$OCCUP^PXBGPRV($GET(^TMP("PXBTANA",$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       QUIT 

SETUP     ;-SETP VARIABLES

 +1       ; FIELD=.01 TEJ *105 CHANGE PARM 12/14/2000

           SET FILE=200

           SET FIELD="@;.01"

 +2        SET HEADING="W !,""ITEM"",?6,""NAME"",?30,""PERSON CLASS IN NEW PERSON FILE"""

 +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