- PRSPUT1 ;WOIFO/MGD - PART TIME PHYSICIAN UTILITIES #1 ;05/17/05
- ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ;The following routine contains various utilities for the Part Time
- ;Physician functionality that was added as part of patch PRS*4.0*93.
- ;
- ;----------------------------------------------------------------------
- ; Determine the IEN of the PT Physician's memorandum if any for the
- ; current date or the date specified in the MDAT parameter.
- ; Input: PTPIEN - IEN of the PT Physician
- ; MDAT - Optional - date within memorandum in FileMan format
- ;
- ; Output: IEN^STATUS
- ; IEN - of the PT Phy's memorandum in the #458.7 file or 0
- ; STATUS - of the memorandum
- ;-----------------------------------------------------------------------
- MIEN(PRSIEN,MDAT) ;
- Q:'PRSIEN 0_"^"
- N ENDAT,MDATA,QUIT,STATUS,STDAT,TDAT,MIEN
- S MDAT=$G(MDAT,DT)
- S (MIEN,QUIT)=0
- F S MIEN=$O(^PRST(458.7,"B",PRSIEN,MIEN)) Q:'MIEN D Q:QUIT
- . S MDATA=$G(^PRST(458.7,MIEN,0))
- . S STDAT=$P(MDATA,U,2) ; START DATE OF MEMORANDUM
- . S ENDAT=$P(MDATA,U,3) ; END DATE OF MEMORANDUM
- . S STATUS=$P(MDATA,U,6) ; STATUS OF MEMORANDUM
- . S TDAT=$P($G(^PRST(458.7,MIEN,4)),U,1) ; TERMINATION DATE
- . I TDAT D
- . . I TDAT<ENDAT S ENDAT=TDAT
- . I MDAT'<STDAT,MDAT'>ENDAT S QUIT=1
- I MIEN="" S MIEN=0,STATUS=0
- Q MIEN_"^"_STATUS
- ;
- ;-----------------------------------------------------------------------
- ;Display information on a PT Physician's memoranda
- ; Input: PRSIEN - IEN of the PT Physician.
- ; SCRTTL - Title for the screen.
- ; ARRAY - The array where the message to be printed will be
- ; stored. (optional) If not specified, no array will
- ; be created.
- ; INDEX - The index where the array will start. (optional) This
- ; will be set to 1 if no index is passed.
- ; PPI - Optional: IEN of the desired PP. If supplied, the
- ; external format will be displayed on line
- ;
- ; Output: VA header, screen title and 10 fields to identify the PT Phy
- ; Array with the same data if the ARRAY parameter is passed.
- ;-----------------------------------------------------------------------
- HDR(PRSIEN,SCRTTL,ARRAY,INDEX,PPI) ;
- Q:'PRSIEN
- S SCRTTL=$G(SCRTTL,"")
- S ARRAY=$G(ARRAY,"")
- I $G(INDEX)="",($G(ARRAY)'="") D INDEX
- N C0,DATE,PPE,SSN,TAB,TEXT,X,YR
- I $G(PPI)="" D ; If no PPI passed in get last PP in #459
- . S PPE="A",PPE=$O(^PRST(459,PPE),-1)
- . S PPE=$P($G(^PRST(459,PPE,0)),U,1)
- I $G(PPI)>0 S PPE=$P($G(^PRST(458,PPI,0)),U,1)
- S TEXT="PP:"_PPE,$E(TEXT,26)="",TEXT=TEXT_"VA TIME & ATTENDANCE SYSTEM"
- D NOW^%DTC
- S YR=%I(3)+1700,YR=$E(YR,3,4)
- S DATE=%I(1)_"/"_%I(2)_"/"_YR
- S $E(TEXT,73)="",TEXT=TEXT_DATE
- D A1 ; Line #1
- S TAB=39-($L(SCRTTL)\2)
- S $E(TEXT,TAB)="",TEXT=TEXT_SCRTTL
- D A1 ; Line #2
- S C0=^PRSPC(PRSIEN,0)
- S TEXT=$P(C0,U,1),$E(TEXT,70)=""
- S SSN=$P(C0,U,9)
- S SSN="XXX-XX-"_$E(SSN,6,9)
- S TEXT=TEXT_SSN
- D A1 ; Line #3
- S TEXT="Pay Plan: "_$P(C0,"^",21)_" Duty Basis: "_$P(C0,"^",10)
- S TEXT=TEXT_" FLSA: "_$P(C0,"^",12)_" Normal Hours: "
- S TEXT=TEXT_$J($P(C0,"^",16),3)_" Comp/Flex: "
- S TEXT=TEXT_$P($G(^PRSPC(PRSIEN,1)),"^",7)
- D A1 ; Line #4
- S TEXT="T&L: "_$P(C0,"^",8),$E(TEXT,69)=""
- S TEXT=TEXT_"Station: "_$P(C0,"^",7)
- D A1 ; Line #5
- K INDEX,%I
- Q
- ;
- ;-----------------------------------------------------------------------
- ; Display information on a PT Physician's memoranda
- ; Input: PRSIEN - IEN of the PT Physician
- ; MIEN - IEN of the PT Phy's memorandum in #458.7
- ; ARRAY - The array where the message to be printed will be
- ; stored. (Optional) If not specified, no array will
- ; be created.
- ; INDEX - The index where the array will start. (optional) This
- ; will be set to 1 if no index is passed.
- ; HRSCO - Carrryover Hours from a prior memorandum. (optional)
- ;
- ; Output: 4 line summary of the PT Phy's current memorandum
- ; Array with the same data if the ARRAY parameter is passed.
- ;-----------------------------------------------------------------------
- MEM(PRSIEN,MIEN,ARRAY,INDEX,HRSCO) ;
- Q:'PRSIEN&('MIEN)
- I $G(INDEX)="",($G(ARRAY)'="") D INDEX
- N AHRS,AHTCM,COHRS,DATA,EDAT,ENDDAT,HRSWK,HTSHBW,I,IEN458,LASTDAY,LASTPP
- N LASTPPE,LPPP,NPHRS,OTHRS,POHC,POMC,POT,PPP,QUIT,TAB,TDAT,TDATEX,TEXT
- N THRSWK,TTEXT,WPHRS
- ; Load 0 node from #458.7. Quit if it doesn't exist
- S DATA=$G(^PRST(458.7,MIEN,0))
- Q:DATA=""
- ; Determine last PP processed
- S LASTPP="A"
- S LASTPP=$O(^PRST(459,LASTPP),-1)
- Q:'LASTPP
- S LASTPPE=$P(^PRST(459,LASTPP,0),U,1)
- S IEN458="",IEN458=$O(^PRST(458,"B",LASTPPE,IEN458))
- Q:'IEN458
- S LASTDAY=$P($G(^PRST(458,IEN458,2)),U,14)
- S TTEXT="Memorandum & Leave Status thru PP "_LASTPPE_" Ending "_LASTDAY
- S TAB=40-($L(TTEXT)\2)
- S $E(TEXT,TAB)="",TEXT=TEXT_TTEXT
- D A1 ; Line #1
- S Y=$P(DATA,U,2) ; START DATE
- D DD^%DT
- S STDAT=Y
- S (EDAT,Y)=$P(DATA,U,3) ; END DATE
- D DD^%DT
- S ENDDAT=Y
- ; Check for Termination
- S (TDAT,Y)=+$G(^PRST(458.7,MIEN,4))
- D DD^%DT
- S TDATEX=Y ; Termination Date External
- S AHRS=$P(DATA,U,4) ; AGREED HOURS
- S COHRS=$P(DATA,U,9) ; CARRYOVER HOURS
- S HRSCO=$G(HRSCO,0) ; HRS CARRIED OVER FROM PRIOR MEMO
- S NPHRS=$P(DATA,U,12) ; NON-PAY HOURS
- S WPHRS=$P(DATA,U,13) ; WITHOUT PAY HOURS
- S THRSWK=0.00 ; TOTAL HOURS WORKED
- S POMC=0.00 ; PERCENTAGE OF MEMORANDA COMPLETED
- S POHC=0.00 ; PERCENTAGE OF HOURS COMPLETED
- S AHTCM=0.00 ; AVERAGE HOURS TO COMPLETE MEMORANDUM
- S POT=0.00 ; % OFF TARGET
- S OTHRS=0.00 ; OFF TARGET HOURS
- S HRSWK=0.00 ; HRS TOTAL FROM WORKED PAY PERIODS
- ;
- S $E(TEXT,2)="",TEXT=TEXT_"Start Date: "_STDAT
- S $E(TEXT,29,31)="| ",TEXT=TEXT_"Agreed Hours: "_$J(AHRS,7,2)
- S $E(TEXT,55,57)="| ",TEXT=TEXT_" LWOP Hrs: "_$J(WPHRS,7,2)
- D A1 ; Line #2
- ;
- S LPPP=$$MEMCPP^PRSPUT3(MIEN)
- S PPP=$P(LPPP,U,2),LPPP=$P(LPPP,U,1)
- ; Check to see if last PP certified in #458 is in #459
- I LPPP'="",'$D(^PRST(459,"B",LPPP)) S PPP=PPP-1
- ; Loop to determine the total hours worked from multiple
- F I=1:1:PPP D
- . S HRSWK=HRSWK+$$GET1^DIQ(458.701,I_","_MIEN_",",1)
- S THRSWK=HRSWK+COHRS+HRSCO ; Adjust for carryover hours
- ; Hrs That Should Have Been Worked - has any NP and WP included
- S HTSHBW=((AHRS/26)*PPP)-NPHRS-WPHRS
- S OTHRS=THRSWK-HTSHBW
- S POHC=THRSWK/(AHRS-NPHRS-WPHRS)*100 ; Adjust % or Hrs Completed
- ; Only calculate the following if memo has started and not ended
- I PPP,PPP<26 D
- . I HTSHBW'=THRSWK D ; PTP has worked more or less than Ave Hrs/PP
- . . I THRSWK'<(AHRS-NPHRS-WPHRS) S AHTCM=0
- . . I THRSWK<(AHRS-NPHRS-WPHRS) S AHTCM=AHRS-THRSWK-NPHRS-WPHRS/(26-PPP)
- . . S POT=(AHRS/26*PPP)-WPHRS-NPHRS
- . . S POT=THRSWK-POT/POT,POT=POT*100
- . I HTSHBW=THRSWK D ; PTP has worked exactly Ave Hrs/PP
- . . S AHTCM=AHRS-THRSWK-WPHRS-NPHRS/(26-PPP)
- . . S POT=0
- I PPP=26 D ; Memo has ended
- . S AHTCM=0
- . S POT=(AHRS/26*PPP)-WPHRS-NPHRS
- . S POT=THRSWK-POT/POT,POT=POT*100
- I PPP=0 D ; 1st PP hasn't been processed
- . S AHTCM=AHRS-COHRS/26
- . S POT=0
- I TDAT D
- . S $E(TEXT,2)="",TEXT=TEXT_"TERMINATED: "_TDATEX
- I TDAT=0 S $E(TEXT,4)="",TEXT=TEXT_"End Date: "_ENDDAT
- S $E(TEXT,29,31)="| ",TEXT=TEXT_"Hours Worked: "_$J(HRSWK,7,2)
- S $E(TEXT,55,57)="| ",TEXT=TEXT_" Non Pay Hrs: "_$J(NPHRS,7,2)
- D A1 ; Line #3
- ;
- S POMC=PPP_" of 26 PP = "_$J(100*(PPP/26),6,2)_"%"
- I PPP<10 S $E(TEXT,6)="",TEXT=TEXT_POMC
- I PPP>9 S $E(TEXT,5)="",TEXT=TEXT_POMC
- S $E(TEXT,29,30)="| "
- S TEXT=TEXT_"Carryover Hrs: "_$J($S(HRSCO:HRSCO,1:COHRS),7,2)
- S $E(TEXT,55,57)="| ",TEXT=TEXT_"Off Target Hrs: "_$J(OTHRS,7,2)
- D A1 ; Line #4
- ;
- S TEXT="% Hrs Completed = "_$J(POHC,6,2)_"%"
- S $E(TEXT,29,31)="| ",TEXT=TEXT_" Total Hrs: "
- S TEXT=TEXT_$J(THRSWK,7,2)
- S $E(TEXT,55,57)="| ",TEXT=TEXT_" Off Target %: "_$J(POT,7,2)
- D A1 ; Line #5
- ;
- I PPP<26 D
- . S TEXT=(AHRS-NPHRS-WPHRS)-THRSWK,TEXT=TEXT/(26-PPP)
- . S TEXT=$FN(TEXT,"",2)
- . S TEXT=" Agreement will be met by averaging "_TEXT
- . S TEXT=TEXT_" Hrs/PP during remainder of memo."
- ;
- I PPP=26 D
- . S $E(TEXT,30)="",TEXT=TEXT_"This memorandum has ended"
- ;
- I TDAT D
- . I LPPP'="" D
- . . S LPPP=$O(^PRST(458,"B",LPPP,0))
- . . S LPPP=$P($G(^PRST(458,LPPP,1)),U,14)
- . . I TDAT'>LPPP D Q
- . . . S TEXT="",$E(TEXT,30)="",TEXT=TEXT_"This memorandum has ended"
- ;
- D A1 ; Line #6
- K INDEX,Y
- Q
- ;
- A1 ; Set TEXT into the array
- ;
- N A1
- W !,TEXT
- I $G(ARRAY)'="" D
- . S A1="S "_ARRAY_INDEX_")="_""""_TEXT_""""
- . X A1
- . S INDEX=INDEX+1
- S TEXT=""
- Q
- ;
- INDEX ; Get last index in array if not passed in
- ;
- S INDEX="S INDEX=$O("_ARRAY_"""A""),-1)"
- X INDEX
- I 'INDEX S INDEX=1 Q
- I INDEX S INDEX=INDEX+1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPUT1 8994 printed Jan 18, 2025@03:29:30 Page 2
- PRSPUT1 ;WOIFO/MGD - PART TIME PHYSICIAN UTILITIES #1 ;05/17/05
- +1 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ;The following routine contains various utilities for the Part Time
- +5 ;Physician functionality that was added as part of patch PRS*4.0*93.
- +6 ;
- +7 ;----------------------------------------------------------------------
- +8 ; Determine the IEN of the PT Physician's memorandum if any for the
- +9 ; current date or the date specified in the MDAT parameter.
- +10 ; Input: PTPIEN - IEN of the PT Physician
- +11 ; MDAT - Optional - date within memorandum in FileMan format
- +12 ;
- +13 ; Output: IEN^STATUS
- +14 ; IEN - of the PT Phy's memorandum in the #458.7 file or 0
- +15 ; STATUS - of the memorandum
- +16 ;-----------------------------------------------------------------------
- MIEN(PRSIEN,MDAT) ;
- +1 if 'PRSIEN
- QUIT 0_"^"
- +2 NEW ENDAT,MDATA,QUIT,STATUS,STDAT,TDAT,MIEN
- +3 SET MDAT=$GET(MDAT,DT)
- +4 SET (MIEN,QUIT)=0
- +5 FOR
- SET MIEN=$ORDER(^PRST(458.7,"B",PRSIEN,MIEN))
- if 'MIEN
- QUIT
- Begin DoDot:1
- +6 SET MDATA=$GET(^PRST(458.7,MIEN,0))
- +7 ; START DATE OF MEMORANDUM
- SET STDAT=$PIECE(MDATA,U,2)
- +8 ; END DATE OF MEMORANDUM
- SET ENDAT=$PIECE(MDATA,U,3)
- +9 ; STATUS OF MEMORANDUM
- SET STATUS=$PIECE(MDATA,U,6)
- +10 ; TERMINATION DATE
- SET TDAT=$PIECE($GET(^PRST(458.7,MIEN,4)),U,1)
- +11 IF TDAT
- Begin DoDot:2
- +12 IF TDAT<ENDAT
- SET ENDAT=TDAT
- End DoDot:2
- +13 IF MDAT'<STDAT
- IF MDAT'>ENDAT
- SET QUIT=1
- End DoDot:1
- if QUIT
- QUIT
- +14 IF MIEN=""
- SET MIEN=0
- SET STATUS=0
- +15 QUIT MIEN_"^"_STATUS
- +16 ;
- +17 ;-----------------------------------------------------------------------
- +18 ;Display information on a PT Physician's memoranda
- +19 ; Input: PRSIEN - IEN of the PT Physician.
- +20 ; SCRTTL - Title for the screen.
- +21 ; ARRAY - The array where the message to be printed will be
- +22 ; stored. (optional) If not specified, no array will
- +23 ; be created.
- +24 ; INDEX - The index where the array will start. (optional) This
- +25 ; will be set to 1 if no index is passed.
- +26 ; PPI - Optional: IEN of the desired PP. If supplied, the
- +27 ; external format will be displayed on line
- +28 ;
- +29 ; Output: VA header, screen title and 10 fields to identify the PT Phy
- +30 ; Array with the same data if the ARRAY parameter is passed.
- +31 ;-----------------------------------------------------------------------
- HDR(PRSIEN,SCRTTL,ARRAY,INDEX,PPI) ;
- +1 if 'PRSIEN
- QUIT
- +2 SET SCRTTL=$GET(SCRTTL,"")
- +3 SET ARRAY=$GET(ARRAY,"")
- +4 IF $GET(INDEX)=""
- IF ($GET(ARRAY)'="")
- DO INDEX
- +5 NEW C0,DATE,PPE,SSN,TAB,TEXT,X,YR
- +6 ; If no PPI passed in get last PP in #459
- IF $GET(PPI)=""
- Begin DoDot:1
- +7 SET PPE="A"
- SET PPE=$ORDER(^PRST(459,PPE),-1)
- +8 SET PPE=$PIECE($GET(^PRST(459,PPE,0)),U,1)
- End DoDot:1
- +9 IF $GET(PPI)>0
- SET PPE=$PIECE($GET(^PRST(458,PPI,0)),U,1)
- +10 SET TEXT="PP:"_PPE
- SET $EXTRACT(TEXT,26)=""
- SET TEXT=TEXT_"VA TIME & ATTENDANCE SYSTEM"
- +11 DO NOW^%DTC
- +12 SET YR=%I(3)+1700
- SET YR=$EXTRACT(YR,3,4)
- +13 SET DATE=%I(1)_"/"_%I(2)_"/"_YR
- +14 SET $EXTRACT(TEXT,73)=""
- SET TEXT=TEXT_DATE
- +15 ; Line #1
- DO A1
- +16 SET TAB=39-($LENGTH(SCRTTL)\2)
- +17 SET $EXTRACT(TEXT,TAB)=""
- SET TEXT=TEXT_SCRTTL
- +18 ; Line #2
- DO A1
- +19 SET C0=^PRSPC(PRSIEN,0)
- +20 SET TEXT=$PIECE(C0,U,1)
- SET $EXTRACT(TEXT,70)=""
- +21 SET SSN=$PIECE(C0,U,9)
- +22 SET SSN="XXX-XX-"_$EXTRACT(SSN,6,9)
- +23 SET TEXT=TEXT_SSN
- +24 ; Line #3
- DO A1
- +25 SET TEXT="Pay Plan: "_$PIECE(C0,"^",21)_" Duty Basis: "_$PIECE(C0,"^",10)
- +26 SET TEXT=TEXT_" FLSA: "_$PIECE(C0,"^",12)_" Normal Hours: "
- +27 SET TEXT=TEXT_$JUSTIFY($PIECE(C0,"^",16),3)_" Comp/Flex: "
- +28 SET TEXT=TEXT_$PIECE($GET(^PRSPC(PRSIEN,1)),"^",7)
- +29 ; Line #4
- DO A1
- +30 SET TEXT="T&L: "_$PIECE(C0,"^",8)
- SET $EXTRACT(TEXT,69)=""
- +31 SET TEXT=TEXT_"Station: "_$PIECE(C0,"^",7)
- +32 ; Line #5
- DO A1
- +33 KILL INDEX,%I
- +34 QUIT
- +35 ;
- +36 ;-----------------------------------------------------------------------
- +37 ; Display information on a PT Physician's memoranda
- +38 ; Input: PRSIEN - IEN of the PT Physician
- +39 ; MIEN - IEN of the PT Phy's memorandum in #458.7
- +40 ; ARRAY - The array where the message to be printed will be
- +41 ; stored. (Optional) If not specified, no array will
- +42 ; be created.
- +43 ; INDEX - The index where the array will start. (optional) This
- +44 ; will be set to 1 if no index is passed.
- +45 ; HRSCO - Carrryover Hours from a prior memorandum. (optional)
- +46 ;
- +47 ; Output: 4 line summary of the PT Phy's current memorandum
- +48 ; Array with the same data if the ARRAY parameter is passed.
- +49 ;-----------------------------------------------------------------------
- MEM(PRSIEN,MIEN,ARRAY,INDEX,HRSCO) ;
- +1 if 'PRSIEN&('MIEN)
- QUIT
- +2 IF $GET(INDEX)=""
- IF ($GET(ARRAY)'="")
- DO INDEX
- +3 NEW AHRS,AHTCM,COHRS,DATA,EDAT,ENDDAT,HRSWK,HTSHBW,I,IEN458,LASTDAY,LASTPP
- +4 NEW LASTPPE,LPPP,NPHRS,OTHRS,POHC,POMC,POT,PPP,QUIT,TAB,TDAT,TDATEX,TEXT
- +5 NEW THRSWK,TTEXT,WPHRS
- +6 ; Load 0 node from #458.7. Quit if it doesn't exist
- +7 SET DATA=$GET(^PRST(458.7,MIEN,0))
- +8 if DATA=""
- QUIT
- +9 ; Determine last PP processed
- +10 SET LASTPP="A"
- +11 SET LASTPP=$ORDER(^PRST(459,LASTPP),-1)
- +12 if 'LASTPP
- QUIT
- +13 SET LASTPPE=$PIECE(^PRST(459,LASTPP,0),U,1)
- +14 SET IEN458=""
- SET IEN458=$ORDER(^PRST(458,"B",LASTPPE,IEN458))
- +15 if 'IEN458
- QUIT
- +16 SET LASTDAY=$PIECE($GET(^PRST(458,IEN458,2)),U,14)
- +17 SET TTEXT="Memorandum & Leave Status thru PP "_LASTPPE_" Ending "_LASTDAY
- +18 SET TAB=40-($LENGTH(TTEXT)\2)
- +19 SET $EXTRACT(TEXT,TAB)=""
- SET TEXT=TEXT_TTEXT
- +20 ; Line #1
- DO A1
- +21 ; START DATE
- SET Y=$PIECE(DATA,U,2)
- +22 DO DD^%DT
- +23 SET STDAT=Y
- +24 ; END DATE
- SET (EDAT,Y)=$PIECE(DATA,U,3)
- +25 DO DD^%DT
- +26 SET ENDDAT=Y
- +27 ; Check for Termination
- +28 SET (TDAT,Y)=+$GET(^PRST(458.7,MIEN,4))
- +29 DO DD^%DT
- +30 ; Termination Date External
- SET TDATEX=Y
- +31 ; AGREED HOURS
- SET AHRS=$PIECE(DATA,U,4)
- +32 ; CARRYOVER HOURS
- SET COHRS=$PIECE(DATA,U,9)
- +33 ; HRS CARRIED OVER FROM PRIOR MEMO
- SET HRSCO=$GET(HRSCO,0)
- +34 ; NON-PAY HOURS
- SET NPHRS=$PIECE(DATA,U,12)
- +35 ; WITHOUT PAY HOURS
- SET WPHRS=$PIECE(DATA,U,13)
- +36 ; TOTAL HOURS WORKED
- SET THRSWK=0.00
- +37 ; PERCENTAGE OF MEMORANDA COMPLETED
- SET POMC=0.00
- +38 ; PERCENTAGE OF HOURS COMPLETED
- SET POHC=0.00
- +39 ; AVERAGE HOURS TO COMPLETE MEMORANDUM
- SET AHTCM=0.00
- +40 ; % OFF TARGET
- SET POT=0.00
- +41 ; OFF TARGET HOURS
- SET OTHRS=0.00
- +42 ; HRS TOTAL FROM WORKED PAY PERIODS
- SET HRSWK=0.00
- +43 ;
- +44 SET $EXTRACT(TEXT,2)=""
- SET TEXT=TEXT_"Start Date: "_STDAT
- +45 SET $EXTRACT(TEXT,29,31)="| "
- SET TEXT=TEXT_"Agreed Hours: "_$JUSTIFY(AHRS,7,2)
- +46 SET $EXTRACT(TEXT,55,57)="| "
- SET TEXT=TEXT_" LWOP Hrs: "_$JUSTIFY(WPHRS,7,2)
- +47 ; Line #2
- DO A1
- +48 ;
- +49 SET LPPP=$$MEMCPP^PRSPUT3(MIEN)
- +50 SET PPP=$PIECE(LPPP,U,2)
- SET LPPP=$PIECE(LPPP,U,1)
- +51 ; Check to see if last PP certified in #458 is in #459
- +52 IF LPPP'=""
- IF '$DATA(^PRST(459,"B",LPPP))
- SET PPP=PPP-1
- +53 ; Loop to determine the total hours worked from multiple
- +54 FOR I=1:1:PPP
- Begin DoDot:1
- +55 SET HRSWK=HRSWK+$$GET1^DIQ(458.701,I_","_MIEN_",",1)
- End DoDot:1
- +56 ; Adjust for carryover hours
- SET THRSWK=HRSWK+COHRS+HRSCO
- +57 ; Hrs That Should Have Been Worked - has any NP and WP included
- +58 SET HTSHBW=((AHRS/26)*PPP)-NPHRS-WPHRS
- +59 SET OTHRS=THRSWK-HTSHBW
- +60 ; Adjust % or Hrs Completed
- SET POHC=THRSWK/(AHRS-NPHRS-WPHRS)*100
- +61 ; Only calculate the following if memo has started and not ended
- +62 IF PPP
- IF PPP<26
- Begin DoDot:1
- +63 ; PTP has worked more or less than Ave Hrs/PP
- IF HTSHBW'=THRSWK
- Begin DoDot:2
- +64 IF THRSWK'<(AHRS-NPHRS-WPHRS)
- SET AHTCM=0
- +65 IF THRSWK<(AHRS-NPHRS-WPHRS)
- SET AHTCM=AHRS-THRSWK-NPHRS-WPHRS/(26-PPP)
- +66 SET POT=(AHRS/26*PPP)-WPHRS-NPHRS
- +67 SET POT=THRSWK-POT/POT
- SET POT=POT*100
- End DoDot:2
- +68 ; PTP has worked exactly Ave Hrs/PP
- IF HTSHBW=THRSWK
- Begin DoDot:2
- +69 SET AHTCM=AHRS-THRSWK-WPHRS-NPHRS/(26-PPP)
- +70 SET POT=0
- End DoDot:2
- End DoDot:1
- +71 ; Memo has ended
- IF PPP=26
- Begin DoDot:1
- +72 SET AHTCM=0
- +73 SET POT=(AHRS/26*PPP)-WPHRS-NPHRS
- +74 SET POT=THRSWK-POT/POT
- SET POT=POT*100
- End DoDot:1
- +75 ; 1st PP hasn't been processed
- IF PPP=0
- Begin DoDot:1
- +76 SET AHTCM=AHRS-COHRS/26
- +77 SET POT=0
- End DoDot:1
- +78 IF TDAT
- Begin DoDot:1
- +79 SET $EXTRACT(TEXT,2)=""
- SET TEXT=TEXT_"TERMINATED: "_TDATEX
- End DoDot:1
- +80 IF TDAT=0
- SET $EXTRACT(TEXT,4)=""
- SET TEXT=TEXT_"End Date: "_ENDDAT
- +81 SET $EXTRACT(TEXT,29,31)="| "
- SET TEXT=TEXT_"Hours Worked: "_$JUSTIFY(HRSWK,7,2)
- +82 SET $EXTRACT(TEXT,55,57)="| "
- SET TEXT=TEXT_" Non Pay Hrs: "_$JUSTIFY(NPHRS,7,2)
- +83 ; Line #3
- DO A1
- +84 ;
- +85 SET POMC=PPP_" of 26 PP = "_$JUSTIFY(100*(PPP/26),6,2)_"%"
- +86 IF PPP<10
- SET $EXTRACT(TEXT,6)=""
- SET TEXT=TEXT_POMC
- +87 IF PPP>9
- SET $EXTRACT(TEXT,5)=""
- SET TEXT=TEXT_POMC
- +88 SET $EXTRACT(TEXT,29,30)="| "
- +89 SET TEXT=TEXT_"Carryover Hrs: "_$JUSTIFY($SELECT(HRSCO:HRSCO,1:COHRS),7,2)
- +90 SET $EXTRACT(TEXT,55,57)="| "
- SET TEXT=TEXT_"Off Target Hrs: "_$JUSTIFY(OTHRS,7,2)
- +91 ; Line #4
- DO A1
- +92 ;
- +93 SET TEXT="% Hrs Completed = "_$JUSTIFY(POHC,6,2)_"%"
- +94 SET $EXTRACT(TEXT,29,31)="| "
- SET TEXT=TEXT_" Total Hrs: "
- +95 SET TEXT=TEXT_$JUSTIFY(THRSWK,7,2)
- +96 SET $EXTRACT(TEXT,55,57)="| "
- SET TEXT=TEXT_" Off Target %: "_$JUSTIFY(POT,7,2)
- +97 ; Line #5
- DO A1
- +98 ;
- +99 IF PPP<26
- Begin DoDot:1
- +100 SET TEXT=(AHRS-NPHRS-WPHRS)-THRSWK
- SET TEXT=TEXT/(26-PPP)
- +101 SET TEXT=$FNUMBER(TEXT,"",2)
- +102 SET TEXT=" Agreement will be met by averaging "_TEXT
- +103 SET TEXT=TEXT_" Hrs/PP during remainder of memo."
- End DoDot:1
- +104 ;
- +105 IF PPP=26
- Begin DoDot:1
- +106 SET $EXTRACT(TEXT,30)=""
- SET TEXT=TEXT_"This memorandum has ended"
- End DoDot:1
- +107 ;
- +108 IF TDAT
- Begin DoDot:1
- +109 IF LPPP'=""
- Begin DoDot:2
- +110 SET LPPP=$ORDER(^PRST(458,"B",LPPP,0))
- +111 SET LPPP=$PIECE($GET(^PRST(458,LPPP,1)),U,14)
- +112 IF TDAT'>LPPP
- Begin DoDot:3
- +113 SET TEXT=""
- SET $EXTRACT(TEXT,30)=""
- SET TEXT=TEXT_"This memorandum has ended"
- End DoDot:3
- QUIT
- End DoDot:2
- End DoDot:1
- +114 ;
- +115 ; Line #6
- DO A1
- +116 KILL INDEX,Y
- +117 QUIT
- +118 ;
- A1 ; Set TEXT into the array
- +1 ;
- +2 NEW A1
- +3 WRITE !,TEXT
- +4 IF $GET(ARRAY)'=""
- Begin DoDot:1
- +5 SET A1="S "_ARRAY_INDEX_")="_""""_TEXT_""""
- +6 XECUTE A1
- +7 SET INDEX=INDEX+1
- End DoDot:1
- +8 SET TEXT=""
- +9 QUIT
- +10 ;
- INDEX ; Get last index in array if not passed in
- +1 ;
- +2 SET INDEX="S INDEX=$O("_ARRAY_"""A""),-1)"
- +3 XECUTE INDEX
- +4 IF 'INDEX
- SET INDEX=1
- QUIT
- +5 IF INDEX
- SET INDEX=INDEX+1
- +6 QUIT