- 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