source: WorldVistAEHR/trunk/r/PAID-PRS/PRSPESR3.m@ 619

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1PRSPESR3 ;WOIFO/JAH - Part-time physicians ESR Edit;11/04/04
2 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5GETTOUR(PRSIEN,PRSD,TC,Y1,Y4) ; Return all segments of tour with special
6 ; tour indicators if any
7 N L1,A1,L3,L4,PRSTR
8 I Y1="" S Y1=$S(TC=1:"Day Off",TC=2:"Day Tour",TC=3!(TC=4):"Intermittent",1:"")
9 ;
10 S PRSTR=""
11 S (L3,L4)=0
12 ;
13 F L1=1:3:19 S A1=$P(Y1,"^",L1) Q:A1="" D
14 . S L3=L3+1,Y1(L3)=A1
15 . S:$P(Y1,"^",L1+1)'="" Y1(L3)=Y1(L3)_"-"_$P(Y1,"^",L1+1)
16 . S:PRSTR'="" PRSTR=PRSTR_", " S PRSTR=PRSTR_Y1(L3)
17 . I $P(Y1,"^",L1+2)'="" D
18 .. S L3=L3+1
19 .. S Y1(L3)=" "_$P($G(^PRST(457.2,+$P(Y1,"^",L1+2),0)),"^",1)
20 .. S PRSTR=PRSTR_" "_$P($G(^PRST(457.2,+$P(Y1,"^",L1+2),0)),"^",6)
21 ;
22 ; add all segments of second tour if any
23 ;
24 I Y4'="" D
25 .F L1=1:3:19 S A1=$P(Y4,"^",L1) Q:A1="" D
26 .. S L3=L3+1,Y1(L3)=A1
27 .. S:$P(Y4,"^",L1+1)'="" Y1(L3)=Y1(L3)_"-"_$P(Y4,"^",L1+1)
28 .. S:PRSTR'="" PRSTR=PRSTR_", " S PRSTR=PRSTR_Y1(L3)
29 .. I $P(Y4,"^",L1+2)'="" D
30 ... S L3=L3+1
31 ... S Y1(L3)=" "_$P($G(^PRST(457.2,+$P(Y4,"^",L1+2),0)),"^",1)
32 ... S PRSTR=PRSTR_" "_$P($G(^PRST(457.2,+$P(Y1,"^",L1+2),0)),"^",6)
33 ;
34 Q PRSTR
35INCESRS(PRSIEN,PPI) ;function returns count of incomplete ESR
36 ; days (ESR status xref)
37 ; effectively a count of the ptp's unsigned esr days (status < 4).
38 ; days off don't get added to total
39 ;
40 ;
41 N INCS
42 S INCS=0
43 Q:(($G(PRSIEN)'>0)!($G(PPI)'>0)) INCS
44 N PPE,STAT,I
45 S PPE=$P($G(^PRST(458,PPI,0)),U)
46 Q:PPE="" INCS
47 S I=0
48 F S I=$O(^PRST(458,"AEA",PRSIEN,PPE,I)) Q:I="" D
49 . S STAT=$$GETSTAT^PRSPESR1(PRSIEN,PPI,I)
50 . I STAT<4 S INCS=INCS+1
51 Q INCS
52WARNMSG(STR) ; write string to 80 column output
53 ; format a long message string to break lines at words
54 N WORD,I
55 S WORD=""
56 F I=1:1:$L(STR," ") D
57 . S WORD=$P(STR," ",I)
58 . Q:WORD=""
59 . I ($X+$L(WORD)+10)>IOM W !
60 . W WORD," "
61 Q
Note: See TracBrowser for help on using the repository browser.