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

Last change on this file since 1000 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.5 KB
Line 
1PXBDPRV ;ISL/JVS,ESW - ISC DISPLAY PROVIDERS ; 12/5/02 11:29am
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**7,11,108**;Aug 12, 1996
3 ;
4 ;
5EN0 ;---Main entry point
6 ;
7 W IOINLOW
8HEAD ;--HEADER ON LIST
9 S HEAD="- - E N C O U N T E R P R O V I D E R S - -"
10 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 - -"
11 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 - -"
12 W IOINHI,!,IOCUU,?(IOM-$L(HEAD))\2,HEAD
13 W IOINLOW,IOELEOL K HEAD
14 I $D(CLINIC) D PRV^PXBUTL2(CLINIC)
15 ;
16 ;
17 I PXBCNT<11 D DPRV1
18 I PXBCNT>10&($D(PXBNPRV)) D DPRV4("SAME")
19 I PXBCNT>10&('$D(PXBNPRV)) D DPRV4("BEGIN")
20 W IOINORM
21 Q
22 ;
23 ;
24DPRV1 ;--Display the PRV Data
25 N ENTRY,Y
26 S Y=+$G(^AUPNVSIT(PXBVST,0)) D DD^%DT
27 D UNDON^PXBCC
28 W !,"No.",?4,"PROVIDER",?34,"PERSON CLASS ON "_Y,?75,$C(32)
29 W IOEDEOP
30 D UNDOFF^PXBCC
31 ;
32 ;
33 S J=0,PXBCNT=0 F S J=$O(PXBSAM(J)) Q:J="" S PXBCNT=PXBCNT+1 D
34 .S ENTRY=$G(PXBSAM(J)) I $D(PXBNPRV($P(ENTRY,"^",1))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
35 .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
36 .D DIS
37 ;---Write no entries if none exists
38 I '$D(PXBSAM) D NONE^PXBUTL(1)
39 ;-----------UNCOMMENT LINE IF CLINIC PROVIDERS ON SCREEEN---------------
40 ;D DEF^PXBDPRV("A")
41 D DEF^PXBDPRV("D") I '$D(FIRST) K PXBDPRV,PRVDR
42 Q
43 ;
44 ;
45 ;
46DPRV4(SIGN) ;--Display the PROVIDER Data
47 ;
48 ;SIGN=
49 ; '+' add 10 to the starting point in ^TMP("PXBDPRV",$J)
50 ; '-' subtract 10 from the starting point but not less that 0
51 ; 'BEGIN' start at the beginning
52 ; 'SAME' start stays where it's at
53 ; '3'--any number set start to that number
54 ;
55 N PXBSTART
56 I '$D(^TMP("PXBDPRV",$J,"START")) S ^TMP("PXBDPRV",$J,"START")=0
57 I SIGN="BEGIN" S ^TMP("PXBDPRV",$J,"START")=0,PXBSTART=0
58 I SIGN="SAME" S PXBSTART=^TMP("PXBDPRV",$J,"START")
59 I SIGN="+" S PXBSTART=($G(^TMP("PXBDPRV",$J,"START"))+(10)) S:PXBSTART'<PXBCNT PXBSTART=(PXBCNT-(10)) S ^TMP("PXBDPRV",$J,"START")=PXBSTART
60 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
61 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
62 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
63 ;
64 ;
65 I SIGN'="BEGIN" D LOC^PXBCC(3,0) W IOEDEOP
66HEAD4 ;--HEADER ON LIST
67 S HEAD="- - E N C O U N T E R P R O V I D E R S - -"
68 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 - -"
69 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 - -"
70 W !,IORVON,IOCUU,?(IOM-$L(HEAD))\2,HEAD
71 W IORVOFF,IOELEOL K HEAD
72 I $D(CLINIC) D PRV^PXBUTL2(CLINIC)
73 ;
74 ;
75 ;
76 N ENTRY,J,Y
77 D UNDON^PXBCC
78 S Y=+$G(^AUPNVSIT(PXBVST,0)) D DD^%DT
79 W !,"No.",?4,"PROVIDER",?34,"PERSON CLASS ON "_Y,?75,$C(32)
80 W IOEDEOP
81 D UNDOFF^PXBCC
82 ;
83 ;
84 S J=PXBSTART F S J=$O(PXBSAM(J)) Q:J="" Q:J=(PXBSTART+(11)) D
85 .S ENTRY=$G(PXBSAM(J)) I $D(PXBNCPT($P(ENTRY,"^",1))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
86 .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
87 .D DIS
88 I SIGN'="BEGIN" W !!
89 ;----UNCOMMENT LINE TO HAVE CLINIC PROVIDERS ON SCREEN--------------
90 ;D DEF^PXBDPRV("A")
91 D DEF^PXBDPRV("D") I '$D(FIRST) K PXBDPRV,PRVDR
92 Q
93 ;
94 ;
95DEF(CODE) ;---PROCESS DEFAULT LIST OF PROVDIERS
96 ; I CODE="D" JUST SEND DEFAULT
97 ; I CODE="A" JUST SEND THE ARRAY OF PROVIDERS
98 D PRV^PXBUTL2(CLINIC)
99 N PRV,X,CLNAME,STOP,LIST,NAME,NUMBER
100 I '$D(IORC) D TERM^PXBCC
101 I '$D(CODE) W !,"SEND PARAMETER = TO 'D'efault OR 'A'rray" Q
102 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)
103 I $G(CODE)="A" K PXBPMT("DEF") D
104 .S (PRV,STOP)="" F S PRV=$O(PXBPMT("PRV",PRV)) Q:PRV="" Q:STOP=0 D
105 ..I '$D(PXBKY(PRV)) S STOP=0
106 .I STOP="" Q
107 .S CLNAME=$P(^SC(CLINIC,0),"^",1)
108 .S X="Other Providers associated with "_CLNAME_" clinic."
109 .W:PXBCNT<7 ! W !,?(IOM-$L(X))/2,IOINHI,X,IOINLOW
110 .S (PRV,LIST)="" F S PRV=$O(PXBPMT("PRV",PRV)) Q:PRV="" D
111 ..I $D(PXBKY(PRV)) Q
112 ..S LIST=LIST_PRV_" " I $L(LIST," ")>4 W !,?(IOM-$L(LIST))/2,LIST S LIST=""
113 I $G(LIST)]"" W !,?(IOM-$L(LIST))/2,LIST
114 Q
115 ;
116DIS ;----DISPLAY
117 Q
118 I $D(PXBPMT("PRV",$P($P(ENTRY,"^",1),"*"))) W:PXBCNT>11 IORVON W ?37," --Associated with the Clinic--",IORVOFF
119 Q
120 ;
Note: See TracBrowser for help on using the repository browser.