Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXBDPRV

PXBDPRV.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. EN0 ;---Main entry point
  1. ;
  1. W IOINLOW
  1. S HEAD="- - E N C O U N T E R P R O V I D E R S - -"
  1. 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 - -"
  1. 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 - -"
  1. W IOINHI,!,IOCUU,?(IOM-$L(HEAD))\2,HEAD
  1. W IOINLOW,IOELEOL K HEAD
  1. I $D(CLINIC) D PRV^PXBUTL2(CLINIC)
  1. ;
  1. ;
  1. I PXBCNT<11 D DPRV1
  1. I PXBCNT>10&($D(PXBNPRV)) D DPRV4("SAME")
  1. I PXBCNT>10&('$D(PXBNPRV)) D DPRV4("BEGIN")
  1. W IOINORM
  1. Q
  1. ;
  1. ;
  1. DPRV1 ;--Display the PRV Data
  1. N ENTRY,Y
  1. S Y=+$G(^AUPNVSIT(PXBVST,0)) D DD^%DT
  1. D UNDON^PXBCC
  1. W !,"No.",?4,"PROVIDER",?34,"PERSON CLASS ON "_Y,?75,$C(32)
  1. W IOEDEOP
  1. D UNDOFF^PXBCC
  1. ;
  1. ;
  1. S J=0,PXBCNT=0 F S J=$O(PXBSAM(J)) Q:J="" S PXBCNT=PXBCNT+1 D
  1. .S ENTRY=$G(PXBSAM(J)) I $D(PXBNPRV($P(ENTRY,"^",1))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
  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
  1. .D DIS
  1. ;---Write no entries if none exists
  1. I '$D(PXBSAM) D NONE^PXBUTL(1)
  1. ;-----------UNCOMMENT LINE IF CLINIC PROVIDERS ON SCREEEN---------------
  1. ;D DEF^PXBDPRV("A")
  1. D DEF^PXBDPRV("D") I '$D(FIRST) K PXBDPRV,PRVDR
  1. Q
  1. ;
  1. ;
  1. ;
  1. DPRV4(SIGN) ;--Display the PROVIDER Data
  1. ;
  1. ;SIGN=
  1. ; '+' add 10 to the starting point in ^TMP("PXBDPRV",$J)
  1. ; '-' subtract 10 from the starting point but not less that 0
  1. ; 'BEGIN' start at the beginning
  1. ; 'SAME' start stays where it's at
  1. ; '3'--any number set start to that number
  1. ;
  1. N PXBSTART
  1. I '$D(^TMP("PXBDPRV",$J,"START")) S ^TMP("PXBDPRV",$J,"START")=0
  1. I SIGN="BEGIN" S ^TMP("PXBDPRV",$J,"START")=0,PXBSTART=0
  1. I SIGN="SAME" S PXBSTART=^TMP("PXBDPRV",$J,"START")
  1. I SIGN="+" S PXBSTART=($G(^TMP("PXBDPRV",$J,"START"))+(10)) S:PXBSTART'<PXBCNT PXBSTART=(PXBCNT-(10)) S ^TMP("PXBDPRV",$J,"START")=PXBSTART
  1. 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
  1. 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
  1. 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
  1. ;
  1. ;
  1. I SIGN'="BEGIN" D LOC^PXBCC(3,0) W IOEDEOP
  1. HEAD4 ;--HEADER ON LIST
  1. S HEAD="- - E N C O U N T E R P R O V I D E R S - -"
  1. 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 - -"
  1. 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 - -"
  1. W !,IORVON,IOCUU,?(IOM-$L(HEAD))\2,HEAD
  1. W IORVOFF,IOELEOL K HEAD
  1. I $D(CLINIC) D PRV^PXBUTL2(CLINIC)
  1. ;
  1. ;
  1. ;
  1. N ENTRY,J,Y
  1. D UNDON^PXBCC
  1. S Y=+$G(^AUPNVSIT(PXBVST,0)) D DD^%DT
  1. W !,"No.",?4,"PROVIDER",?34,"PERSON CLASS ON "_Y,?75,$C(32)
  1. W IOEDEOP
  1. D UNDOFF^PXBCC
  1. ;
  1. ;
  1. S J=PXBSTART F S J=$O(PXBSAM(J)) Q:J="" Q:J=(PXBSTART+(11)) D
  1. .S ENTRY=$G(PXBSAM(J)) I $D(PXBNCPT($P(ENTRY,"^",1))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
  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
  1. .D DIS
  1. I SIGN'="BEGIN" W !!
  1. ;----UNCOMMENT LINE TO HAVE CLINIC PROVIDERS ON SCREEN--------------
  1. ;D DEF^PXBDPRV("A")
  1. D DEF^PXBDPRV("D") I '$D(FIRST) K PXBDPRV,PRVDR
  1. Q
  1. ;
  1. ;
  1. DEF(CODE) ;---PROCESS DEFAULT LIST OF PROVDIERS
  1. ; I CODE="D" JUST SEND DEFAULT
  1. ; I CODE="A" JUST SEND THE ARRAY OF PROVIDERS
  1. D PRV^PXBUTL2(CLINIC)
  1. N PRV,X,CLNAME,STOP,LIST,NAME,NUMBER
  1. I '$D(IORC) D TERM^PXBCC
  1. I '$D(CODE) W !,"SEND PARAMETER = TO 'D'efault OR 'A'rray" Q
  1. 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)
  1. I $G(CODE)="A" K PXBPMT("DEF") D
  1. .S (PRV,STOP)="" F S PRV=$O(PXBPMT("PRV",PRV)) Q:PRV="" Q:STOP=0 D
  1. ..I '$D(PXBKY(PRV)) S STOP=0
  1. .I STOP="" Q
  1. .S CLNAME=$P(^SC(CLINIC,0),"^",1)
  1. .S X="Other Providers associated with "_CLNAME_" clinic."
  1. .W:PXBCNT<7 ! W !,?(IOM-$L(X))/2,IOINHI,X,IOINLOW
  1. .S (PRV,LIST)="" F S PRV=$O(PXBPMT("PRV",PRV)) Q:PRV="" D
  1. ..I $D(PXBKY(PRV)) Q
  1. ..S LIST=LIST_PRV_" " I $L(LIST," ")>4 W !,?(IOM-$L(LIST))/2,LIST S LIST=""
  1. I $G(LIST)]"" W !,?(IOM-$L(LIST))/2,LIST
  1. Q
  1. ;
  1. DIS ;----DISPLAY
  1. Q
  1. I $D(PXBPMT("PRV",$P($P(ENTRY,"^",1),"*"))) W:PXBCNT>11 IORVON W ?37," --Associated with the Clinic--",IORVOFF
  1. Q
  1. ;