PRSPESR3 ;WOIFO/JAH - Part-time physicians ESR Edit;11/04/04
;;4.0;PAID;**93**;Sep 21, 1995;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
GETTOUR(PRSIEN,PRSD,TC,Y1,Y4) ; Return all segments of tour with special
; tour indicators if any
N L1,A1,L3,L4,PRSTR
I Y1="" S Y1=$S(TC=1:"Day Off",TC=2:"Day Tour",TC=3!(TC=4):"Intermittent",1:"")
;
S PRSTR=""
S (L3,L4)=0
;
F L1=1:3:19 S A1=$P(Y1,"^",L1) Q:A1="" D
. S L3=L3+1,Y1(L3)=A1
. S:$P(Y1,"^",L1+1)'="" Y1(L3)=Y1(L3)_"-"_$P(Y1,"^",L1+1)
. S:PRSTR'="" PRSTR=PRSTR_", " S PRSTR=PRSTR_Y1(L3)
. I $P(Y1,"^",L1+2)'="" D
.. S L3=L3+1
.. S Y1(L3)=" "_$P($G(^PRST(457.2,+$P(Y1,"^",L1+2),0)),"^",1)
.. S PRSTR=PRSTR_" "_$P($G(^PRST(457.2,+$P(Y1,"^",L1+2),0)),"^",6)
;
; add all segments of second tour if any
;
I Y4'="" D
.F L1=1:3:19 S A1=$P(Y4,"^",L1) Q:A1="" D
.. S L3=L3+1,Y1(L3)=A1
.. S:$P(Y4,"^",L1+1)'="" Y1(L3)=Y1(L3)_"-"_$P(Y4,"^",L1+1)
.. S:PRSTR'="" PRSTR=PRSTR_", " S PRSTR=PRSTR_Y1(L3)
.. I $P(Y4,"^",L1+2)'="" D
... S L3=L3+1
... S Y1(L3)=" "_$P($G(^PRST(457.2,+$P(Y4,"^",L1+2),0)),"^",1)
... S PRSTR=PRSTR_" "_$P($G(^PRST(457.2,+$P(Y1,"^",L1+2),0)),"^",6)
;
Q PRSTR
INCESRS(PRSIEN,PPI) ;function returns count of incomplete ESR
; days (ESR status xref)
; effectively a count of the ptp's unsigned esr days (status < 4).
; days off don't get added to total
;
;
N INCS
S INCS=0
Q:(($G(PRSIEN)'>0)!($G(PPI)'>0)) INCS
N PPE,STAT,I
S PPE=$P($G(^PRST(458,PPI,0)),U)
Q:PPE="" INCS
S I=0
F S I=$O(^PRST(458,"AEA",PRSIEN,PPE,I)) Q:I="" D
. S STAT=$$GETSTAT^PRSPESR1(PRSIEN,PPI,I)
. I STAT<4 S INCS=INCS+1
Q INCS
WARNMSG(STR) ; write string to 80 column output
; format a long message string to break lines at words
N WORD,I
S WORD=""
F I=1:1:$L(STR," ") D
. S WORD=$P(STR," ",I)
. Q:WORD=""
. I ($X+$L(WORD)+10)>IOM W !
. W WORD," "
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPESR3 1963 printed Oct 16, 2024@18:28:50 Page 2
PRSPESR3 ;WOIFO/JAH - Part-time physicians ESR Edit;11/04/04
+1 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
GETTOUR(PRSIEN,PRSD,TC,Y1,Y4) ; Return all segments of tour with special
+1 ; tour indicators if any
+2 NEW L1,A1,L3,L4,PRSTR
+3 IF Y1=""
SET Y1=$SELECT(TC=1:"Day Off",TC=2:"Day Tour",TC=3!(TC=4):"Intermittent",1:"")
+4 ;
+5 SET PRSTR=""
+6 SET (L3,L4)=0
+7 ;
+8 FOR L1=1:3:19
SET A1=$PIECE(Y1,"^",L1)
if A1=""
QUIT
Begin DoDot:1
+9 SET L3=L3+1
SET Y1(L3)=A1
+10 if $PIECE(Y1,"^",L1+1)'=""
SET Y1(L3)=Y1(L3)_"-"_$PIECE(Y1,"^",L1+1)
+11 if PRSTR'=""
SET PRSTR=PRSTR_", "
SET PRSTR=PRSTR_Y1(L3)
+12 IF $PIECE(Y1,"^",L1+2)'=""
Begin DoDot:2
+13 SET L3=L3+1
+14 SET Y1(L3)=" "_$PIECE($GET(^PRST(457.2,+$PIECE(Y1,"^",L1+2),0)),"^",1)
+15 SET PRSTR=PRSTR_" "_$PIECE($GET(^PRST(457.2,+$PIECE(Y1,"^",L1+2),0)),"^",6)
End DoDot:2
End DoDot:1
+16 ;
+17 ; add all segments of second tour if any
+18 ;
+19 IF Y4'=""
Begin DoDot:1
+20 FOR L1=1:3:19
SET A1=$PIECE(Y4,"^",L1)
if A1=""
QUIT
Begin DoDot:2
+21 SET L3=L3+1
SET Y1(L3)=A1
+22 if $PIECE(Y4,"^",L1+1)'=""
SET Y1(L3)=Y1(L3)_"-"_$PIECE(Y4,"^",L1+1)
+23 if PRSTR'=""
SET PRSTR=PRSTR_", "
SET PRSTR=PRSTR_Y1(L3)
+24 IF $PIECE(Y4,"^",L1+2)'=""
Begin DoDot:3
+25 SET L3=L3+1
+26 SET Y1(L3)=" "_$PIECE($GET(^PRST(457.2,+$PIECE(Y4,"^",L1+2),0)),"^",1)
+27 SET PRSTR=PRSTR_" "_$PIECE($GET(^PRST(457.2,+$PIECE(Y1,"^",L1+2),0)),"^",6)
End DoDot:3
End DoDot:2
End DoDot:1
+28 ;
+29 QUIT PRSTR
INCESRS(PRSIEN,PPI) ;function returns count of incomplete ESR
+1 ; days (ESR status xref)
+2 ; effectively a count of the ptp's unsigned esr days (status < 4).
+3 ; days off don't get added to total
+4 ;
+5 ;
+6 NEW INCS
+7 SET INCS=0
+8 if (($GET(PRSIEN)'>0)!($GET(PPI)'>0))
QUIT INCS
+9 NEW PPE,STAT,I
+10 SET PPE=$PIECE($GET(^PRST(458,PPI,0)),U)
+11 if PPE=""
QUIT INCS
+12 SET I=0
+13 FOR
SET I=$ORDER(^PRST(458,"AEA",PRSIEN,PPE,I))
if I=""
QUIT
Begin DoDot:1
+14 SET STAT=$$GETSTAT^PRSPESR1(PRSIEN,PPI,I)
+15 IF STAT<4
SET INCS=INCS+1
End DoDot:1
+16 QUIT INCS
WARNMSG(STR) ; write string to 80 column output
+1 ; format a long message string to break lines at words
+2 NEW WORD,I
+3 SET WORD=""
+4 FOR I=1:1:$LENGTH(STR," ")
Begin DoDot:1
+5 SET WORD=$PIECE(STR," ",I)
+6 if WORD=""
QUIT
+7 IF ($X+$LENGTH(WORD)+10)>IOM
WRITE !
+8 WRITE WORD," "
End DoDot:1
+9 QUIT
