- 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 Feb 18, 2025@23:54:10 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
