PRSNEE0 ;WOIFO/PLT - Utility of Nurse POC Data A/E/D ; 08/14/2009 7:56 AM
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified.
QUIT
;
;return value=^1 is 1 if primary or secondary is a 2-day tour ^2=meal time ^3=y if 2-day tour ^4=meal time of secondary ^5=y if 2-day tour of secondary
PSTOUR(PPI,DFN,PRSNDAY) ;ef - primary and secondary tour info
N A,B
S A=$G(^PRST(458,PPI,"E",DFN,"D",PRSNDAY,0))
I A="" QUIT ""
S B=$P($G(^PRST(457.1,+$P(A,U,2),0)),U,3)_U_$P($G(^(0)),U,5)
S:$P(A,U,13)]"" B=B_U_$P($G(^PRST(457.1,+$P(A,U,13),0)),U,3)_U_$P($G(^(0)),U,5)
QUIT $P(B,U,2)="Y"!($P(B,U,4)="Y")_U_B
;
;get prsnt array of tour of duty and exceptions from eta
;build prsnpc array from the prsnt array
;prsnpc(start militaty time)=^1-start time (military), ^2- stop time (military)
; ^3-eta type of time, ^4-meal time
ETAPOC ;convert eta tour of duty and exceptions time segments to array prsnpc
N A,B,C
K PRSNT,PRSNPC D BLDTC^PRSNRMM(.PRSNT,DFN,PPI,PRSNDAY,1)
S PRSNPC=$P(PRSNT,U)'=0_"^"_$P(PRSNT,U,2)
S A=0 F S A=$O(PRSNT(A)) QUIT:'A S B=PRSNT(A) I $P(B,U,4) S A=$P(B,U,4),C=$G(PRSNT(A)),C=C+$S(C#100<45:15,1:55),PRSNPC(+B)=+B_U_C_U_$P(B,U,5)_U_$P(B,U,7)
K PRSNT
QUIT
;
ADDTS ;add poc time segments in file #451.9999 of file# 451
N PRSNA,PRSNB,PRSNC
S PRSNA=""
F S PRSNA=$O(PRSNPC(PRSNA)) QUIT:PRSNA="" D
. N X,Y,A,B,C,D
. ;set x and x("r")
. S A=PRSNPC(PRSNA),X=$E(A>2400*-2400+A+10000,2,5) D ^PRSATIM
. S B=$P(A,U,2),C=$P(A,U,3),D=$P(A,U,4),B=$E(B>2400*-2400+B+10000,2,5)
. S PRSNB=$S(",OT,CT,RG,"[C&(C]""):"V",1:""),PRSNC=$S(",WI,OT,CT,RG,HW,"'[C:"",$P(PRSNUR,U,4)="DC":$O(^PRSN(451.5,"B","DC",0)),1:"")
. S X("DR")="1///"_B_";2////"_D_";3////"_C_";4////"_$P(PRSNLOC,U)_";5////"_PRSNC_";6////"_PRSNB_";8////"_$P(A,U)_";9////"_$P(A,U,2)
. D ADD^PRSU1B1(.X,.Y,"451;;"_PPI_"~451.09;;"_DFN_"~451.99;;"_PRSNDAY_"~451.999;;"_PRSNVER_";~451.9999;^PRSN(451,PPI,""E"",DFN,""D"",PRSNDAY,""V"",PRSNVER,""T"",")
. QUIT
QUIT
;
;called from screenman form page 1 or page 1.5
;a=start time, b=stop time, c=1 if start time starts day 1, =2 if day 2
MILSS(A,B,C) ;ef:^1-military start time, ^2-military stop time, ^3 invalid message
N X,Y,D,E
S D="",E=""
I A'="" S Y=0,X=A D MIL^PRSATIM S D=C-1*2400+Y
I B'="" S Y=1,X=B D MIL^PRSATIM S Y=C-1*2400+Y,E=Y S:Y'>D E=2400+Y
QUIT D_"^"_E_"^"_$S(E>2400&(C=1):"Stop Time is in the Second Day of the tour. Its Type of Time must be OT/CT/RG.",E>4800&(C=2):"Stop Time is in the Third Day of the tour.",1:"")
;
;data validation check before save
DATAVAL ;called from form for data validation
N PRSNA,PRSNB,PRSNC,PRSND,PRSNE,PRSNERR,PRSNDIE,PRSNDA,PRSNTT,PRSNOTT,PRSNOTR,PRSNM
S PRSNERR=0
S PRSNDIE="^PRSN(451,"_PPI_",""E"","_DFN_",""D"","_PRSNDAY_",""V"","_PRSNVER_",""T"","
S PRSNDA(4)=PPI,PRSNDA(3)=DFN,PRSNDA(2)=PRSNDAY,PRSNDA(1)=PRSNVER
S PRSNDA=0
F S PRSNDA=$O(^PRSN(451,PPI,"E",DFN,"D",PRSNDAY,"V",PRSNVER,"T",PRSNDA)) QUIT:'PRSNDA D
. S PRSNA=$$GET^DDSVAL(PRSNDIE,.PRSNDA,.01)
. S PRSNB=$$GET^DDSVAL(PRSNDIE,.PRSNDA,8)
. S PRSNC=$$GET^DDSVAL(PRSNDIE,.PRSNDA,9)
. S PRSNM=$$GET^DDSVAL(PRSNDIE,.PRSNDA,2)
. S PRSNTT=$$GET^DDSVAL(PRSNDIE,.PRSNDA,3)
. S PRSNOTT=$$GET^DDSVAL(PRSNDIE,.PRSNDA,6)
. S PRSNOTR=$$GET^DDSVAL(PRSNDIE,.PRSNDA,7)
. I PRSNTT'="",",OT,CT,RG,"[PRSNTT D
.. I PRSNOTT="" S PRSNERR=PRSNERR+1,PRSNERR(PRSNERR)="Subrecord: "_PRSNA_" is missing overtime type"
.. I PRSNOTR="" S PRSNERR=PRSNERR+1,PRSNERR(PRSNERR)="Subrecord: "_PRSNA_" is missing overtime reason"
. I PRSNB=""!(PRSNC="") S PRSNERR=PRSNERR+1,PRSNERR(PRSNERR)="Subrecord: "_PRSNA_" has wrong Stop Time" QUIT
. I $D(PRSNB(PRSNB)) S PRSNERR=PRSNERR+1,PRSNERR(PRSNERR)="Subrecord: "_PRSNA_" has duplicate Start Time" QUIT
. S PRSNB(PRSNB)=PRSNC_"^"_PRSNA_"^"_PRSNM
. QUIT
S PRSNB=""
F S PRSNB=$O(PRSNB(PRSNB)) QUIT:PRSNB="" D
. S PRSNC=+PRSNB(PRSNB)
. S PRSNM=$P(PRSNB(PRSNB),U,3)
. I PRSNM,PRSNC\100*60+(PRSNC#100)-(PRSNB\100*60+(PRSNB#100))<PRSNM S PRSNERR=PRSNERR+1,PRSNERR(PRSNERR)="Meal Time is over Start/Stop Time."
. S PRSND=$O(PRSNB(PRSNB))
. S PRSNE=$O(PRSNB(PRSNC-1))
. I PRSND'=PRSNE S PRSNERR=PRSNERR+1,PRSNERR(PRSNERR)="Subrecord: "_$P(PRSNB(PRSNB),U,2)_" has Stop Time greater than Start Time of the next time segment"
. QUIT
I PRSNERR D HLP^DDSUTL(.PRSNERR) S DDSERROR=1,DDSBR="1^2^1"
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNEE0 4439 printed Apr 09, 2024@21:30:54 Page 2
PRSNEE0 ;WOIFO/PLT - Utility of Nurse POC Data A/E/D ; 08/14/2009 7:56 AM
+1 ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;return value=^1 is 1 if primary or secondary is a 2-day tour ^2=meal time ^3=y if 2-day tour ^4=meal time of secondary ^5=y if 2-day tour of secondary
PSTOUR(PPI,DFN,PRSNDAY) ;ef - primary and secondary tour info
+1 NEW A,B
+2 SET A=$GET(^PRST(458,PPI,"E",DFN,"D",PRSNDAY,0))
+3 IF A=""
QUIT ""
+4 SET B=$PIECE($GET(^PRST(457.1,+$PIECE(A,U,2),0)),U,3)_U_$PIECE($GET(^(0)),U,5)
+5 if $PIECE(A,U,13)]""
SET B=B_U_$PIECE($GET(^PRST(457.1,+$PIECE(A,U,13),0)),U,3)_U_$PIECE($GET(^(0)),U,5)
+6 QUIT $PIECE(B,U,2)="Y"!($PIECE(B,U,4)="Y")_U_B
+7 ;
+8 ;get prsnt array of tour of duty and exceptions from eta
+9 ;build prsnpc array from the prsnt array
+10 ;prsnpc(start militaty time)=^1-start time (military), ^2- stop time (military)
+11 ; ^3-eta type of time, ^4-meal time
ETAPOC ;convert eta tour of duty and exceptions time segments to array prsnpc
+1 NEW A,B,C
+2 KILL PRSNT,PRSNPC
DO BLDTC^PRSNRMM(.PRSNT,DFN,PPI,PRSNDAY,1)
+3 SET PRSNPC=$PIECE(PRSNT,U)'=0_"^"_$PIECE(PRSNT,U,2)
+4 SET A=0
FOR
SET A=$ORDER(PRSNT(A))
if 'A
QUIT
SET B=PRSNT(A)
IF $PIECE(B,U,4)
SET A=$PIECE(B,U,4)
SET C=$GET(PRSNT(A))
SET C=C+$SELECT(C#100<45:15,1:55)
SET PRSNPC(+B)=+B_U_C_U_$PIECE(B,U,5)_U_$PIECE(B,U,7)
+5 KILL PRSNT
+6 QUIT
+7 ;
ADDTS ;add poc time segments in file #451.9999 of file# 451
+1 NEW PRSNA,PRSNB,PRSNC
+2 SET PRSNA=""
+3 FOR
SET PRSNA=$ORDER(PRSNPC(PRSNA))
if PRSNA=""
QUIT
Begin DoDot:1
+4 NEW X,Y,A,B,C,D
+5 ;set x and x("r")
+6 SET A=PRSNPC(PRSNA)
SET X=$EXTRACT(A>2400*-2400+A+10000,2,5)
DO ^PRSATIM
+7 SET B=$PIECE(A,U,2)
SET C=$PIECE(A,U,3)
SET D=$PIECE(A,U,4)
SET B=$EXTRACT(B>2400*-2400+B+10000,2,5)
+8 SET PRSNB=$SELECT(",OT,CT,RG,"[C&(C]""):"V",1:"")
SET PRSNC=$SELECT(",WI,OT,CT,RG,HW,"'[C:"",$PIECE(PRSNUR,U,4)="DC":$ORDER(^PRSN(451.5,"B","DC",0)),1:"")
+9 SET X("DR")="1///"_B_";2////"_D_";3////"_C_";4////"_$PIECE(PRSNLOC,U)_";5////"_PRSNC_";6////"_PRSNB_";8////"_$PIECE(A,U)_";9////"_$PIECE(A,U,2)
+10 DO ADD^PRSU1B1(.X,.Y,"451;;"_PPI_"~451.09;;"_DFN_"~451.99;;"_PRSNDAY_"~451.999;;"_PRSNVER_";~451.9999;^PRSN(451,PPI,""E"",DFN,""D"",PRSNDAY,""V"",PRSNVER,""T"",")
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
+14 ;called from screenman form page 1 or page 1.5
+15 ;a=start time, b=stop time, c=1 if start time starts day 1, =2 if day 2
MILSS(A,B,C) ;ef:^1-military start time, ^2-military stop time, ^3 invalid message
+1 NEW X,Y,D,E
+2 SET D=""
SET E=""
+3 IF A'=""
SET Y=0
SET X=A
DO MIL^PRSATIM
SET D=C-1*2400+Y
+4 IF B'=""
SET Y=1
SET X=B
DO MIL^PRSATIM
SET Y=C-1*2400+Y
SET E=Y
if Y'>D
SET E=2400+Y
+5 QUIT D_"^"_E_"^"_$SELECT(E>2400&(C=1):"Stop Time is in the Second Day of the tour. Its Type of Time must be OT/CT/RG.",E>4800&(C=2):"Stop Time is in the Third Day of the tour.",1:"")
+6 ;
+7 ;data validation check before save
DATAVAL ;called from form for data validation
+1 NEW PRSNA,PRSNB,PRSNC,PRSND,PRSNE,PRSNERR,PRSNDIE,PRSNDA,PRSNTT,PRSNOTT,PRSNOTR,PRSNM
+2 SET PRSNERR=0
+3 SET PRSNDIE="^PRSN(451,"_PPI_",""E"","_DFN_",""D"","_PRSNDAY_",""V"","_PRSNVER_",""T"","
+4 SET PRSNDA(4)=PPI
SET PRSNDA(3)=DFN
SET PRSNDA(2)=PRSNDAY
SET PRSNDA(1)=PRSNVER
+5 SET PRSNDA=0
+6 FOR
SET PRSNDA=$ORDER(^PRSN(451,PPI,"E",DFN,"D",PRSNDAY,"V",PRSNVER,"T",PRSNDA))
if 'PRSNDA
QUIT
Begin DoDot:1
+7 SET PRSNA=$$GET^DDSVAL(PRSNDIE,.PRSNDA,.01)
+8 SET PRSNB=$$GET^DDSVAL(PRSNDIE,.PRSNDA,8)
+9 SET PRSNC=$$GET^DDSVAL(PRSNDIE,.PRSNDA,9)
+10 SET PRSNM=$$GET^DDSVAL(PRSNDIE,.PRSNDA,2)
+11 SET PRSNTT=$$GET^DDSVAL(PRSNDIE,.PRSNDA,3)
+12 SET PRSNOTT=$$GET^DDSVAL(PRSNDIE,.PRSNDA,6)
+13 SET PRSNOTR=$$GET^DDSVAL(PRSNDIE,.PRSNDA,7)
+14 IF PRSNTT'=""
IF ",OT,CT,RG,"[PRSNTT
Begin DoDot:2
+15 IF PRSNOTT=""
SET PRSNERR=PRSNERR+1
SET PRSNERR(PRSNERR)="Subrecord: "_PRSNA_" is missing overtime type"
+16 IF PRSNOTR=""
SET PRSNERR=PRSNERR+1
SET PRSNERR(PRSNERR)="Subrecord: "_PRSNA_" is missing overtime reason"
End DoDot:2
+17 IF PRSNB=""!(PRSNC="")
SET PRSNERR=PRSNERR+1
SET PRSNERR(PRSNERR)="Subrecord: "_PRSNA_" has wrong Stop Time"
QUIT
+18 IF $DATA(PRSNB(PRSNB))
SET PRSNERR=PRSNERR+1
SET PRSNERR(PRSNERR)="Subrecord: "_PRSNA_" has duplicate Start Time"
QUIT
+19 SET PRSNB(PRSNB)=PRSNC_"^"_PRSNA_"^"_PRSNM
+20 QUIT
End DoDot:1
+21 SET PRSNB=""
+22 FOR
SET PRSNB=$ORDER(PRSNB(PRSNB))
if PRSNB=""
QUIT
Begin DoDot:1
+23 SET PRSNC=+PRSNB(PRSNB)
+24 SET PRSNM=$PIECE(PRSNB(PRSNB),U,3)
+25 IF PRSNM
IF PRSNC\100*60+(PRSNC#100)-(PRSNB\100*60+(PRSNB#100))<PRSNM
SET PRSNERR=PRSNERR+1
SET PRSNERR(PRSNERR)="Meal Time is over Start/Stop Time."
+26 SET PRSND=$ORDER(PRSNB(PRSNB))
+27 SET PRSNE=$ORDER(PRSNB(PRSNC-1))
+28 IF PRSND'=PRSNE
SET PRSNERR=PRSNERR+1
SET PRSNERR(PRSNERR)="Subrecord: "_$PIECE(PRSNB(PRSNB),U,2)_" has Stop Time greater than Start Time of the next time segment"
+29 QUIT
End DoDot:1
+30 IF PRSNERR
DO HLP^DDSUTL(.PRSNERR)
SET DDSERROR=1
SET DDSBR="1^2^1"
+31 QUIT
