PRSNRUT1 ;WOIFO/DAM - API Pull POC Data;060409
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified
;
;INPUT:
; PPIEN: Pay period IEN is in TIME & ATTENDANCE RECORDS file (#458)
; The .01 field is the pay period, eg "09-07"
; and matches the .01 field in
; POC DAILY TIME RECORDS file (#451)
; The IEN is in the 2nd subscript and B xref of
; the .01 field in file (#458)
; PRSIEN: Nurse IEN is the .01 field in the POC DAILY TIME RECORDS
; file (#451) multiple 451.09
; PRSNDAY: Day number is the .01 field in POC DAILY TIME RECORDS
; file (#451) multiple 451.99. This parameter is optional.
; If a DAY is not passed in, results for the entire pay
; period are returned.
; PRSNVER: "C" or "P" to retrieve Current or Previous version of time record
;
;OUTPUT:
; Returns array POCD(N)="Start Time^Stop Time^Meal Time
; ^Type of Time^Point of Care^Type of Work^Mandatory Indicator
; ^Reason for OT/CT/RG"
;
L1(POCD,PPIEN,PRSIEN,PRSNDAY,PRSNVER) ;EMPLOYEE
;Called from PRSNRUT0
;
S PRSNVER=$G(PRSNVER,"C")
S POCD(0)=0
N N
S N=1
N PRSND0,PRSND1,PRSND2,PRSND3,PRSND4
S PRSND0=PPIEN
S PRSND1=0
F S PRSND1=$O(^PRSN(451,PRSND0,"E",PRSND1)) Q:PRSND1'>0 D
. I $P($G(^PRSN(451,PRSND0,"E",PRSND1,0)),U,1)=PRSIEN D
. . D L2(.POCD,PRSND0,PRSND1,PRSNDAY,PRSNVER)
Q
;
L2(POCD,PRSND0,PRSND1,PRSNDAY,PRSNVER) ;Loop through DAY entries
;
S PRSNVER=$G(PRSNVER,"C")
S PRSND2=0
F S PRSND2=$O(^PRSN(451,PRSND0,"E",PRSND1,"D",PRSND2)) Q:'PRSND2 D
. I $P(^PRSN(451,PRSND0,"E",PRSND1,"D",PRSND2,0),U,1)=PRSNDAY D
.. D L3(.POCD,PRSND0,PRSND1,PRSND2,PRSNVER)
. I PRSNDAY="" D L3(.POCD,PRSND0,PRSND1,PRSND2,PRSNVER)
Q
;
L3(POCD,PRSND0,PRSND1,PRSND2,PRSNVER) ;Loop through VERSION entries
;
S PRSNVER=$G(PRSNVER,"C")
S PRSND3=99999
S PRSND3=$O(^PRSN(451,PRSND0,"E",PRSND1,"D",PRSND2,"V",PRSND3),-1)
Q:PRSND3=""
I PRSNVER="P" S PRSND3=$O(^PRSN(451,PRSND0,"E",PRSND1,"D",PRSND2,"V",PRSND3),-1)
Q:PRSND3=""
D L4(.POCD,PRSND0,PRSND1,PRSND2,PRSND3)
Q
;
L4(POCD,PRSND0,PRSND1,PRSND2,PRSND3) ;RETURN DATA
;
S PRSND4=0
F S PRSND4=$O(^PRSN(451,PRSND0,"E",PRSND1,"D",PRSND2,"V",PRSND3,"T",PRSND4)) Q:'PRSND4 D
. S POCD(N)=$P(^PRSN(451,PRSND0,"E",PRSND1,"D",PRSND2,"V",PRSND3,"T",PRSND4,0),U,1,10)
. S $P(POCD(N),U,11)=PRSND3
. S POCD(0)=N
. S N=N+1
;If there is at least one time segment then we are done
Q:N>1
;Otherwise, update version number here for deleted time records
S $P(POCD(N),U,11)=PRSND3
S POCD(0)=N
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNRUT1 2740 printed Dec 13, 2024@02:27:38 Page 2
PRSNRUT1 ;WOIFO/DAM - API Pull POC Data;060409
+1 ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
+4 ;INPUT:
+5 ; PPIEN: Pay period IEN is in TIME & ATTENDANCE RECORDS file (#458)
+6 ; The .01 field is the pay period, eg "09-07"
+7 ; and matches the .01 field in
+8 ; POC DAILY TIME RECORDS file (#451)
+9 ; The IEN is in the 2nd subscript and B xref of
+10 ; the .01 field in file (#458)
+11 ; PRSIEN: Nurse IEN is the .01 field in the POC DAILY TIME RECORDS
+12 ; file (#451) multiple 451.09
+13 ; PRSNDAY: Day number is the .01 field in POC DAILY TIME RECORDS
+14 ; file (#451) multiple 451.99. This parameter is optional.
+15 ; If a DAY is not passed in, results for the entire pay
+16 ; period are returned.
+17 ; PRSNVER: "C" or "P" to retrieve Current or Previous version of time record
+18 ;
+19 ;OUTPUT:
+20 ; Returns array POCD(N)="Start Time^Stop Time^Meal Time
+21 ; ^Type of Time^Point of Care^Type of Work^Mandatory Indicator
+22 ; ^Reason for OT/CT/RG"
+23 ;
L1(POCD,PPIEN,PRSIEN,PRSNDAY,PRSNVER) ;EMPLOYEE
+1 ;Called from PRSNRUT0
+2 ;
+3 SET PRSNVER=$GET(PRSNVER,"C")
+4 SET POCD(0)=0
+5 NEW N
+6 SET N=1
+7 NEW PRSND0,PRSND1,PRSND2,PRSND3,PRSND4
+8 SET PRSND0=PPIEN
+9 SET PRSND1=0
+10 FOR
SET PRSND1=$ORDER(^PRSN(451,PRSND0,"E",PRSND1))
if PRSND1'>0
QUIT
Begin DoDot:1
+11 IF $PIECE($GET(^PRSN(451,PRSND0,"E",PRSND1,0)),U,1)=PRSIEN
Begin DoDot:2
+12 DO L2(.POCD,PRSND0,PRSND1,PRSNDAY,PRSNVER)
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
L2(POCD,PRSND0,PRSND1,PRSNDAY,PRSNVER) ;Loop through DAY entries
+1 ;
+2 SET PRSNVER=$GET(PRSNVER,"C")
+3 SET PRSND2=0
+4 FOR
SET PRSND2=$ORDER(^PRSN(451,PRSND0,"E",PRSND1,"D",PRSND2))
if 'PRSND2
QUIT
Begin DoDot:1
+5 IF $PIECE(^PRSN(451,PRSND0,"E",PRSND1,"D",PRSND2,0),U,1)=PRSNDAY
Begin DoDot:2
+6 DO L3(.POCD,PRSND0,PRSND1,PRSND2,PRSNVER)
End DoDot:2
+7 IF PRSNDAY=""
DO L3(.POCD,PRSND0,PRSND1,PRSND2,PRSNVER)
End DoDot:1
+8 QUIT
+9 ;
L3(POCD,PRSND0,PRSND1,PRSND2,PRSNVER) ;Loop through VERSION entries
+1 ;
+2 SET PRSNVER=$GET(PRSNVER,"C")
+3 SET PRSND3=99999
+4 SET PRSND3=$ORDER(^PRSN(451,PRSND0,"E",PRSND1,"D",PRSND2,"V",PRSND3),-1)
+5 if PRSND3=""
QUIT
+6 IF PRSNVER="P"
SET PRSND3=$ORDER(^PRSN(451,PRSND0,"E",PRSND1,"D",PRSND2,"V",PRSND3),-1)
+7 if PRSND3=""
QUIT
+8 DO L4(.POCD,PRSND0,PRSND1,PRSND2,PRSND3)
+9 QUIT
+10 ;
L4(POCD,PRSND0,PRSND1,PRSND2,PRSND3) ;RETURN DATA
+1 ;
+2 SET PRSND4=0
+3 FOR
SET PRSND4=$ORDER(^PRSN(451,PRSND0,"E",PRSND1,"D",PRSND2,"V",PRSND3,"T",PRSND4))
if 'PRSND4
QUIT
Begin DoDot:1
+4 SET POCD(N)=$PIECE(^PRSN(451,PRSND0,"E",PRSND1,"D",PRSND2,"V",PRSND3,"T",PRSND4,0),U,1,10)
+5 SET $PIECE(POCD(N),U,11)=PRSND3
+6 SET POCD(0)=N
+7 SET N=N+1
End DoDot:1
+8 ;If there is at least one time segment then we are done
+9 if N>1
QUIT
+10 ;Otherwise, update version number here for deleted time records
+11 SET $PIECE(POCD(N),U,11)=PRSND3
+12 SET POCD(0)=N
+13 ;
+14 QUIT
