PXBGPRV2 ;ISL/JVS - DOUBLE ?? GATHERING OF PROVIDER ; 7/12/07 10:38am
;;1.0;PCE PATIENT CARE ENCOUNTER;**7,11,19,105,186**;Aug 12, 1996;Build 3
;
;
;
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,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
;
; begin patch *186*
S:$G(SCREEN)="" SCREEN="I $$ACTIVPRV^PXAPI(Y,$G(IDATE,DT))"
;D LIST^DIC(FILE,"",FIELD,BACK,10,.START,"","","","","^TMP(""PXBTANA"",$J)","^TMP(""PXBTANA"",$J)")
D LIST^DIC(FILE,"",FIELD,BACK,10,.START,"","",SCREEN,"","^TMP(""PXBTANA"",$J)","^TMP(""PXBTANA"",$J)")
; end patch *186*
;
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
; begin patch *186*
; S BACK="",INDEX="",TOTAL1=0
S BACK="",INDEX="",TOTAL=0
; end patch *186*
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"
;----------------
; begin patch *186*
;S SCREEN=""
S SCREEN="I $$ACTIVPRV^PXAPI(Y,$G(IDATE,DT))"
; end patch *186*
;
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($P($G(^AUPNVSIT(PXBVST,0)),U),"."))
;-----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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBGPRV2 6882 printed Oct 16, 2024@18:27:25 Page 2
PXBGPRV2 ;ISL/JVS - DOUBLE ?? GATHERING OF PROVIDER ; 7/12/07 10:38am
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**7,11,19,105,186**;Aug 12, 1996;Build 3
+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 NEW FILE,FIELD,TITLE,HEADING,SUB,CODE,NAME,START,SCREEN,BACK,NUM,TEMP
+8 ;
+9 SET BACK=""
SET NUM=0
SET SCREEN=""
+10 DO LOC
+11 IF $DATA(DIC("S"))
SET SCREEN=DIC("S")
+12 ;
START ;--RECYCLE POINT
+1 ;
+2 SET TITLE="- - A L L P R O V I D E R S - -"
+3 ;
+4 DO SETUP
+5 ;
+6 ; begin patch *186*
+7 if $GET(SCREEN)=""
SET SCREEN="I $$ACTIVPRV^PXAPI(Y,$G(IDATE,DT))"
+8 ;D LIST^DIC(FILE,"",FIELD,BACK,10,.START,"","","","","^TMP(""PXBTANA"",$J)","^TMP(""PXBTANA"",$J)")
+9 DO LIST^DIC(FILE,"",FIELD,BACK,10,.START,"","",SCREEN,"","^TMP(""PXBTANA"",$J)","^TMP(""PXBTANA"",$J)")
+10 ; end patch *186*
+11 ;
+12 DO LOC
DO HEAD
DO SUB
+13 ;
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 ; begin patch *186*
+6 ; S BACK="",INDEX="",TOTAL1=0
+7 SET BACK=""
SET INDEX=""
SET TOTAL=0
+8 ; end patch *186*
+9 SET START=DATA
SET SUB=0
SET SUB2=0
+10 ;
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 ; begin patch *186*
+6 ;S SCREEN=""
+7 SET SCREEN="I $$ACTIVPRV^PXAPI(Y,$G(IDATE,DT))"
+8 ; end patch *186*
+9 ;
+10 DO LIST^DIC(FILE,"",FIELD,BACK,"",.START,DATA,INDEX,SCREEN,"","^TMP(""PXBTOTAL"",$J)","^TMP(""PXBTOTAL"",$J)")
+11 SET TOTAL=$PIECE(^TMP("PXBTOTAL",$JOB,"DILIST",0),"^",1)
+12 ;-------------VA NUMBER------------------
+13 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)))=""
+14 SET START=$ORDER(^VA(200,"PS2",DATA),-1)
+15 IF DATA=+DATA
SET START=DATA_" "
+16 FOR
SET START=$ORDER(^VA(200,"PS2",START))
if START'[DATA
QUIT
Begin DoDot:1
+17 if $DATA(VANUMBER($ORDER(^VA(200,"PS2",START,0))))
QUIT
+18 NEW IEN
+19 SET TOTAL=TOTAL+1
+20 SET (IEN,^TMP("PXBTOTAL",$JOB,"DILIST",2,TOTAL))=$ORDER(^VA(200,"PS2",START,0))
+21 SET ^TMP("PXBTOTAL",$JOB,"DILIST","ID",TOTAL,.01)=$PIECE($GET(^VA(200,IEN,0)),"^",1)
End DoDot:1
+22 ;----------END VA NUMBERS-----------------
+23 ;
+24 ;--DISPLAY IF NO MATCH FOUND
+25 IF TOTAL=0
Begin DoDot:1
+26 DO WIN17^PXBCC(PXBCNT)
+27 IF DATA?1AP
WRITE !
DO HELP^PXBUTL0("CPT4")
+28 IF DATA'?1AP
WRITE !
DO HELP^PXBUTL0("PRVM")
+29 SET ERROR=1
SET CYCL=1
End DoDot:1
+30 IF TOTAL=0
QUIT TOTAL
+31 ;
+32 ;
+33 ;----DISPLAY LIST TO THE SCREEN
+34 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($PIECE($GET(^AUPNVSIT(PXBVST,0)),U),"."))
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
