| 1 | PRSPESR3 ;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
|
|---|
| 5 | GETTOUR(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
|
|---|
| 35 | INCESRS(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
|
|---|
| 52 | WARNMSG(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
|
|---|
