source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXBDPRV.m@ 1397

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
 ;