PXBDPRV ;ISL/JVS,ESW - ISC DISPLAY PROVIDERS ; 12/5/02 11:29am
;;1.0;PCE PATIENT CARE ENCOUNTER;**7,11,108**;Aug 12, 1996
;
;
EN0 ;---Main entry point
;
W IOINLOW
HEAD ;--HEADER ON LIST
S HEAD="- - E N C O U N T E R P R O V I D E R S - -"
I $D(FROM),FROM="CPT" S HEAD="- - E N C O U N T E R P R O V I D E R S - -"
I $D(FROM),FROM="PL" S HEAD="- - E N C O U N T E R P R O V I D E R S - -"
W IOINHI,!,IOCUU,?(IOM-$L(HEAD))\2,HEAD
W IOINLOW,IOELEOL K HEAD
I $D(CLINIC) D PRV^PXBUTL2(CLINIC)
;
;
I PXBCNT<11 D DPRV1
I PXBCNT>10&($D(PXBNPRV)) D DPRV4("SAME")
I PXBCNT>10&('$D(PXBNPRV)) D DPRV4("BEGIN")
W IOINORM
Q
;
;
DPRV1 ;--Display the PRV Data
N ENTRY,Y
S Y=+$G(^AUPNVSIT(PXBVST,0)) D DD^%DT
D UNDON^PXBCC
W !,"No.",?4,"PROVIDER",?34,"PERSON CLASS ON "_Y,?75,$C(32)
W IOEDEOP
D UNDOFF^PXBCC
;
;
S J=0,PXBCNT=0 F S J=$O(PXBSAM(J)) Q:J="" S PXBCNT=PXBCNT+1 D
.S ENTRY=$G(PXBSAM(J)) I $D(PXBNPRV($P(ENTRY,"^",1))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
.W !,J,?4,$E($P(ENTRY,"^",1),1,19),?25 W:$P(ENTRY,"^",2)["PRI" $P(ENTRY,"^",2) W ?34 W:ENTRY["**" IOINHI W $E($P(ENTRY,"^",3),1,42),IOINLOW
.D DIS
;---Write no entries if none exists
I '$D(PXBSAM) D NONE^PXBUTL(1)
;-----------UNCOMMENT LINE IF CLINIC PROVIDERS ON SCREEEN---------------
;D DEF^PXBDPRV("A")
D DEF^PXBDPRV("D") I '$D(FIRST) K PXBDPRV,PRVDR
Q
;
;
;
DPRV4(SIGN) ;--Display the PROVIDER Data
;
;SIGN=
; '+' add 10 to the starting point in ^TMP("PXBDPRV",$J)
; '-' subtract 10 from the starting point but not less that 0
; 'BEGIN' start at the beginning
; 'SAME' start stays where it's at
; '3'--any number set start to that number
;
N PXBSTART
I '$D(^TMP("PXBDPRV",$J,"START")) S ^TMP("PXBDPRV",$J,"START")=0
I SIGN="BEGIN" S ^TMP("PXBDPRV",$J,"START")=0,PXBSTART=0
I SIGN="SAME" S PXBSTART=^TMP("PXBDPRV",$J,"START")
I SIGN="+" S PXBSTART=($G(^TMP("PXBDPRV",$J,"START"))+(10)) S:PXBSTART'<PXBCNT PXBSTART=(PXBCNT-(10)) S ^TMP("PXBDPRV",$J,"START")=PXBSTART
I SIGN="-" S PXBSTART=$G(^TMP("PXBDPRV",$J,"START"))-10,^TMP("PXBDPRV",$J,"START")=PXBSTART I PXBSTART<0 S PXBSTART=0 S ^TMP("PXBDPRV",$J,"START")=0
I +SIGN>0&(SIGN#10) S PXBSTART=$P((SIGN/10),".")*10 S:PXBSTART<10 PXBSTART=0 Q:^TMP("PXBDPRV",$J,"START")=PXBSTART S ^TMP("PXBDPRV",$J,"START")=PXBSTART
I +SIGN>0&'(SIGN#10) S PXBSTART=(($P((SIGN/10),".")*10)-10) S:PXBSTART<10 PXBSTART=0 Q:^TMP("PXBDPRV",$J,"START")=PXBSTART S ^TMP("PXBDPRV",$J,"START")=PXBSTART
;
;
I SIGN'="BEGIN" D LOC^PXBCC(3,0) W IOEDEOP
HEAD4 ;--HEADER ON LIST
S HEAD="- - E N C O U N T E R P R O V I D E R S - -"
I $D(FROM),FROM="CPT" S HEAD="- - E N C O U N T E R P R O V I D E R S - -"
I $D(FROM),FROM="PL" S HEAD="- - E N C O U N T E R P R O V I D E R S - -"
W !,IORVON,IOCUU,?(IOM-$L(HEAD))\2,HEAD
W IORVOFF,IOELEOL K HEAD
I $D(CLINIC) D PRV^PXBUTL2(CLINIC)
;
;
;
N ENTRY,J,Y
D UNDON^PXBCC
S Y=+$G(^AUPNVSIT(PXBVST,0)) D DD^%DT
W !,"No.",?4,"PROVIDER",?34,"PERSON CLASS ON "_Y,?75,$C(32)
W IOEDEOP
D UNDOFF^PXBCC
;
;
S J=PXBSTART F S J=$O(PXBSAM(J)) Q:J="" Q:J=(PXBSTART+(11)) D
.S ENTRY=$G(PXBSAM(J)) I $D(PXBNCPT($P(ENTRY,"^",1))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
.W !,J,?4,$E($P(ENTRY,"^",1),1,19),?25 W:$P(ENTRY,"^",2)["PRI" $P(ENTRY,"^",2) W ?34 W:ENTRY["**" IOINHI W $E($P(ENTRY,"^",3),1,42),IOINLOW
.D DIS
I SIGN'="BEGIN" W !!
;----UNCOMMENT LINE TO HAVE CLINIC PROVIDERS ON SCREEN--------------
;D DEF^PXBDPRV("A")
D DEF^PXBDPRV("D") I '$D(FIRST) K PXBDPRV,PRVDR
Q
;
;
DEF(CODE) ;---PROCESS DEFAULT LIST OF PROVDIERS
; I CODE="D" JUST SEND DEFAULT
; I CODE="A" JUST SEND THE ARRAY OF PROVIDERS
D PRV^PXBUTL2(CLINIC)
N PRV,X,CLNAME,STOP,LIST,NAME,NUMBER
I '$D(IORC) D TERM^PXBCC
I '$D(CODE) W !,"SEND PARAMETER = TO 'D'efault OR 'A'rray" Q
I $G(CODE)="D",$D(PXBPMT("DEF")) S NAME=$O(PXBPMT("DEF",0)) S NUMBER=$O(PXBPMT("DEF",NAME,0)) S PXBDPRV=NUMBER_"^"_NAME S:$D(PRVDR) PXBDPRV="^"_$P(PRVDR("PRIMARY"),U)
I $G(CODE)="A" K PXBPMT("DEF") D
.S (PRV,STOP)="" F S PRV=$O(PXBPMT("PRV",PRV)) Q:PRV="" Q:STOP=0 D
..I '$D(PXBKY(PRV)) S STOP=0
.I STOP="" Q
.S CLNAME=$P(^SC(CLINIC,0),"^",1)
.S X="Other Providers associated with "_CLNAME_" clinic."
.W:PXBCNT<7 ! W !,?(IOM-$L(X))/2,IOINHI,X,IOINLOW
.S (PRV,LIST)="" F S PRV=$O(PXBPMT("PRV",PRV)) Q:PRV="" D
..I $D(PXBKY(PRV)) Q
..S LIST=LIST_PRV_" " I $L(LIST," ")>4 W !,?(IOM-$L(LIST))/2,LIST S LIST=""
I $G(LIST)]"" W !,?(IOM-$L(LIST))/2,LIST
Q
;
DIS ;----DISPLAY
Q
I $D(PXBPMT("PRV",$P($P(ENTRY,"^",1),"*"))) W:PXBCNT>11 IORVON W ?37," --Associated with the Clinic--",IORVOFF
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBDPRV 4689 printed Dec 13, 2024@02:26:27 Page 2
PXBDPRV ;ISL/JVS,ESW - ISC DISPLAY PROVIDERS ; 12/5/02 11:29am
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**7,11,108**;Aug 12, 1996
+2 ;
+3 ;
EN0 ;---Main entry point
+1 ;
+2 WRITE IOINLOW
HEAD ;--HEADER ON LIST
+1 SET HEAD="- - E N C O U N T E R P R O V I D E R S - -"
+2 IF $DATA(FROM)
IF FROM="CPT"
SET HEAD="- - E N C O U N T E R P R O V I D E R S - -"
+3 IF $DATA(FROM)
IF FROM="PL"
SET HEAD="- - E N C O U N T E R P R O V I D E R S - -"
+4 WRITE IOINHI,!,IOCUU,?(IOM-$LENGTH(HEAD))\2,HEAD
+5 WRITE IOINLOW,IOELEOL
KILL HEAD
+6 IF $DATA(CLINIC)
DO PRV^PXBUTL2(CLINIC)
+7 ;
+8 ;
+9 IF PXBCNT<11
DO DPRV1
+10 IF PXBCNT>10&($DATA(PXBNPRV))
DO DPRV4("SAME")
+11 IF PXBCNT>10&('$DATA(PXBNPRV))
DO DPRV4("BEGIN")
+12 WRITE IOINORM
+13 QUIT
+14 ;
+15 ;
DPRV1 ;--Display the PRV Data
+1 NEW ENTRY,Y
+2 SET Y=+$GET(^AUPNVSIT(PXBVST,0))
DO DD^%DT
+3 DO UNDON^PXBCC
+4 WRITE !,"No.",?4,"PROVIDER",?34,"PERSON CLASS ON "_Y,?75,$CHAR(32)
+5 WRITE IOEDEOP
+6 DO UNDOFF^PXBCC
+7 ;
+8 ;
+9 SET J=0
SET PXBCNT=0
FOR
SET J=$ORDER(PXBSAM(J))
if J=""
QUIT
SET PXBCNT=PXBCNT+1
Begin DoDot:1
+10 SET ENTRY=$GET(PXBSAM(J))
IF $DATA(PXBNPRV($PIECE(ENTRY,"^",1)))
SET $PIECE(ENTRY,"^",1)=$PIECE(ENTRY,"^",1)_"*"
+11 WRITE !,J,?4,$EXTRACT($PIECE(ENTRY,"^",1),1,19),?25
if $PIECE(ENTRY,"^",2)["PRI"
WRITE $PIECE(ENTRY,"^",2)
WRITE ?34
if ENTRY["**"
WRITE IOINHI
WRITE $EXTRACT($PIECE(ENTRY,"^",3),1,42),IOINLOW
+12 DO DIS
End DoDot:1
+13 ;---Write no entries if none exists
+14 IF '$DATA(PXBSAM)
DO NONE^PXBUTL(1)
+15 ;-----------UNCOMMENT LINE IF CLINIC PROVIDERS ON SCREEEN---------------
+16 ;D DEF^PXBDPRV("A")
+17 DO DEF^PXBDPRV("D")
IF '$DATA(FIRST)
KILL PXBDPRV,PRVDR
+18 QUIT
+19 ;
+20 ;
+21 ;
DPRV4(SIGN) ;--Display the PROVIDER Data
+1 ;
+2 ;SIGN=
+3 ; '+' add 10 to the starting point in ^TMP("PXBDPRV",$J)
+4 ; '-' subtract 10 from the starting point but not less that 0
+5 ; 'BEGIN' start at the beginning
+6 ; 'SAME' start stays where it's at
+7 ; '3'--any number set start to that number
+8 ;
+9 NEW PXBSTART
+10 IF '$DATA(^TMP("PXBDPRV",$JOB,"START"))
SET ^TMP("PXBDPRV",$JOB,"START")=0
+11 IF SIGN="BEGIN"
SET ^TMP("PXBDPRV",$JOB,"START")=0
SET PXBSTART=0
+12 IF SIGN="SAME"
SET PXBSTART=^TMP("PXBDPRV",$JOB,"START")
+13 IF SIGN="+"
SET PXBSTART=($GET(^TMP("PXBDPRV",$JOB,"START"))+(10))
if PXBSTART'<PXBCNT
SET PXBSTART=(PXBCNT-(10))
SET ^TMP("PXBDPRV",$JOB,"START")=PXBSTART
+14 IF SIGN="-"
SET PXBSTART=$GET(^TMP("PXBDPRV",$JOB,"START"))-10
SET ^TMP("PXBDPRV",$JOB,"START")=PXBSTART
IF PXBSTART<0
SET PXBSTART=0
SET ^TMP("PXBDPRV",$JOB,"START")=0
+15 IF +SIGN>0&(SIGN#10)
SET PXBSTART=$PIECE((SIGN/10),".")*10
if PXBSTART<10
SET PXBSTART=0
if ^TMP("PXBDPRV",$JOB,"START")=PXBSTART
QUIT
SET ^TMP("PXBDPRV",$JOB,"START")=PXBSTART
+16 IF +SIGN>0&'(SIGN#10)
SET PXBSTART=(($PIECE((SIGN/10),".")*10)-10)
if PXBSTART<10
SET PXBSTART=0
if ^TMP("PXBDPRV",$JOB,"START")=PXBSTART
QUIT
SET ^TMP("PXBDPRV",$JOB,"START")=PXBSTART
+17 ;
+18 ;
+19 IF SIGN'="BEGIN"
DO LOC^PXBCC(3,0)
WRITE IOEDEOP
HEAD4 ;--HEADER ON LIST
+1 SET HEAD="- - E N C O U N T E R P R O V I D E R S - -"
+2 IF $DATA(FROM)
IF FROM="CPT"
SET HEAD="- - E N C O U N T E R P R O V I D E R S - -"
+3 IF $DATA(FROM)
IF FROM="PL"
SET HEAD="- - E N C O U N T E R P R O V I D E R S - -"
+4 WRITE !,IORVON,IOCUU,?(IOM-$LENGTH(HEAD))\2,HEAD
+5 WRITE IORVOFF,IOELEOL
KILL HEAD
+6 IF $DATA(CLINIC)
DO PRV^PXBUTL2(CLINIC)
+7 ;
+8 ;
+9 ;
+10 NEW ENTRY,J,Y
+11 DO UNDON^PXBCC
+12 SET Y=+$GET(^AUPNVSIT(PXBVST,0))
DO DD^%DT
+13 WRITE !,"No.",?4,"PROVIDER",?34,"PERSON CLASS ON "_Y,?75,$CHAR(32)
+14 WRITE IOEDEOP
+15 DO UNDOFF^PXBCC
+16 ;
+17 ;
+18 SET J=PXBSTART
FOR
SET J=$ORDER(PXBSAM(J))
if J=""
QUIT
if J=(PXBSTART+(11))
QUIT
Begin DoDot:1
+19 SET ENTRY=$GET(PXBSAM(J))
IF $DATA(PXBNCPT($PIECE(ENTRY,"^",1)))
SET $PIECE(ENTRY,"^",1)=$PIECE(ENTRY,"^",1)_"*"
+20 WRITE !,J,?4,$EXTRACT($PIECE(ENTRY,"^",1),1,19),?25
if $PIECE(ENTRY,"^",2)["PRI"
WRITE $PIECE(ENTRY,"^",2)
WRITE ?34
if ENTRY["**"
WRITE IOINHI
WRITE $EXTRACT($PIECE(ENTRY,"^",3),1,42),IOINLOW
+21 DO DIS
End DoDot:1
+22 IF SIGN'="BEGIN"
WRITE !!
+23 ;----UNCOMMENT LINE TO HAVE CLINIC PROVIDERS ON SCREEN--------------
+24 ;D DEF^PXBDPRV("A")
+25 DO DEF^PXBDPRV("D")
IF '$DATA(FIRST)
KILL PXBDPRV,PRVDR
+26 QUIT
+27 ;
+28 ;
DEF(CODE) ;---PROCESS DEFAULT LIST OF PROVDIERS
+1 ; I CODE="D" JUST SEND DEFAULT
+2 ; I CODE="A" JUST SEND THE ARRAY OF PROVIDERS
+3 DO PRV^PXBUTL2(CLINIC)
+4 NEW PRV,X,CLNAME,STOP,LIST,NAME,NUMBER
+5 IF '$DATA(IORC)
DO TERM^PXBCC
+6 IF '$DATA(CODE)
WRITE !,"SEND PARAMETER = TO 'D'efault OR 'A'rray"
QUIT
+7 IF $GET(CODE)="D"
IF $DATA(PXBPMT("DEF"))
SET NAME=$ORDER(PXBPMT("DEF",0))
SET NUMBER=$ORDER(PXBPMT("DEF",NAME,0))
SET PXBDPRV=NUMBER_"^"_NAME
if $DATA(PRVDR)
SET PXBDPRV="^"_$PIECE(PRVDR("PRIMARY"),U)
+8 IF $GET(CODE)="A"
KILL PXBPMT("DEF")
Begin DoDot:1
+9 SET (PRV,STOP)=""
FOR
SET PRV=$ORDER(PXBPMT("PRV",PRV))
if PRV=""
QUIT
if STOP=0
QUIT
Begin DoDot:2
+10 IF '$DATA(PXBKY(PRV))
SET STOP=0
End DoDot:2
+11 IF STOP=""
QUIT
+12 SET CLNAME=$PIECE(^SC(CLINIC,0),"^",1)
+13 SET X="Other Providers associated with "_CLNAME_" clinic."
+14 if PXBCNT<7
WRITE !
WRITE !,?(IOM-$LENGTH(X))/2,IOINHI,X,IOINLOW
+15 SET (PRV,LIST)=""
FOR
SET PRV=$ORDER(PXBPMT("PRV",PRV))
if PRV=""
QUIT
Begin DoDot:2
+16 IF $DATA(PXBKY(PRV))
QUIT
+17 SET LIST=LIST_PRV_" "
IF $LENGTH(LIST," ")>4
WRITE !,?(IOM-$LENGTH(LIST))/2,LIST
SET LIST=""
End DoDot:2
End DoDot:1
+18 IF $GET(LIST)]""
WRITE !,?(IOM-$LENGTH(LIST))/2,LIST
+19 QUIT
+20 ;
DIS ;----DISPLAY
+1 QUIT
+2 IF $DATA(PXBPMT("PRV",$PIECE($PIECE(ENTRY,"^",1),"*")))
if PXBCNT>11
WRITE IORVON
WRITE ?37," --Associated with the Clinic--",IORVOFF
+3 QUIT
+4 ;
