PRSNCAPE ;WOIFO/DWA - PAID PARAMETER ENTER/EDIT ;07/30/09
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
; Key variables used in this routine:
;
; PPI,PPE,PPST = Current pay period internal value, external
; value and start date
; LPPE,LPST = Last pay period external value and start date
; NPPE,NPST = Next pay period external value and start date
;
; IENS = Internal entry number of selected institution
; IENS2 = External value of selected institution
;
; PRSFDA = A name spaced FileMan Data Array
; PAYPD = External value of selected effective pay period
; PPDI = Internal entry number of selected effective
; pay period
;
;
EN ; Entry point for PAID Application Parameter Edit
N OUT S OUT=0 D SHODIVAC(.OUT) Q:OUT
K DIC
N PPI,PPE,PPST,LPPE,LPST,NPPE,NPST,IENS,IENS2,PRSFDA,PAYPD,PPDI
N X1,X2,X,Y,ORIGPP,NAM,NAM2
S PPI=$P($G(^PRST(458,"AD",DT)),"^")
I 'PPI W !!,"Current Pay Period must be open for testing. Quitting." Q
S PPE=$P(^PRST(458,PPI,0),"^")
S LPPE=$P(^PRST(458,PPI-1,0),"^")
S NPPE=$E($$NXTPP^PRSAPPU(PPE),3,7)
S PPST=$P(^PRST(458,PPI,1),"^")
S LPST=$P(^PRST(458,PPI-1,1),"^")
S X1=PPST,X2=14 D C^%DTC S NPST=X
D HDR
N DIC,X,Y,DUOUT,DTOUT,DLAYGO
S DIC="^PRST(456,",DIC(0)="ALEQMZ",DLAYGO=456,DIC("A")="Select Institution: "
D ^DIC
Q:$D(DUOUT)!$D(DTOUT)!(+Y'>0)
S IENS=+Y,IENS2=$P(Y,U,2)
PPDS ; Set the effective pay period
S X=PPST D DTP^PRSAPPU
W !!!,"C = Current Pay Period beginning "_Y
S X=LPST D DTP^PRSAPPU
W !,"L = Last Pay Period beginning "_Y
S X=NPST D DTP^PRSAPPU
W !,"N = Next Pay Period beginning "_Y,!
N DIR,DIRUT,Y,PRSDT
S DIR(0)="SB^C:Current;N:Next;L:Last",DIR("A")="Select Effective Pay Period; Current, Next, Last"
D ^DIR K DIR Q:$D(DIRUT)
W !!
S PAYPD=$S(Y="C":PPE,Y="N":NPPE,1:LPPE)
;
S PRSDT=$S(Y="C":PPST,Y="N":NPST,1:LPST)
;
S PPDI=$O(^PRST(456,IENS,1,"B",PAYPD,0))
;
S NAM=$$DIVACC^PRSNUT02(PRSDT,IENS2)
S ORIGPP=$P(NAM,U,2)
S NAM=$P(NAM,U)
S NAM2=$S(NAM="N":"T",1:"N")
;
; If no existing entry, set one up, otherwise Update existing entry
I PPDI'>0 D
. D NA1
E D
. W !!,"The Nurse Access Method for "_$$EXTERNAL^DILFD(456,.01,"",IENS2)_" pay period "_PAYPD_" is currently set to ",!,$$EXTERNAL^DILFD(456.05,1,"",NAM)_". Do you wish to change it?",!!
. N DIR,Y,DIRUT
. S DIR(0)="Y",DIR("B")="Yes" D ^DIR K DIR Q:$D(DIRUT)
. I Y=0 W " No changes made, quitting.",!! Q
. S NAM=NAM2
. S PRSFDA(456.05,PPDI_","_IENS_",",1)=NAM
. D FILE^DIE("","PRSFDA",""),MSG^DIALOG()
. W !!,"The Nurse Access Method for "_$$EXTERNAL^DILFD(456,.01,"",IENS2)_" has been successfully changed to ",!,$$EXTERNAL^DILFD(456.05,1,"",NAM)_" Effective Pay Period "_PAYPD_".",!!
. Q
Q
;
;
NA1 ; Create a new sub-record and set nurse access parameter
;
N STOP,PPDI
S STOP=0
N DIR,Y,DIRUT
I ORIGPP'="" D
. W !!,"The Nurse Access Method for "_$$EXTERNAL^DILFD(456,.01,"",IENS2)_" pay period "_PAYPD_" is currently set to ",!,$$EXTERNAL^DILFD(456.05,1,"",NAM)_". Do you wish to change it?",!! D
. S DIR(0)="Y",DIR("B")="Yes" D ^DIR K DIR Q:$D(DIRUT)
. I Y=0 W " No changes made, quitting.",!! S STOP=1 Q
. S NAM=NAM2
E D
. S DIR(0)="SB^N:Nurse Location;T:T&L Unit",DIR("A")="Select Nurse Access Method; Nurse Location or T&L Unit" D ^DIR K DIR Q:$D(DIRUT)
. S NAM=X
;
Q:STOP
N PRSFDA,PRSIENS,PPDI
S PRSFDA(456.05,"+2,"_IENS_",",.01)=PAYPD
D UPDATE^DIE("","PRSFDA","PRSIENS"),MSG^DIALOG()
S PPDI=PRSIENS(2)
S PRSFDA(456.05,PPDI_","_IENS_",",1)=NAM
D FILE^DIE("","PRSFDA",""),MSG^DIALOG()
W !!,"The Nurse Access Method for "_$$EXTERNAL^DILFD(456,.01,"",IENS2)_" has been successfully set to ",!,$$EXTERNAL^DILFD(456.05,1,"",NAM)_" Effective Pay Period "_PAYPD_".",!!
Q
;
;
;
HDR ;
N L1,L2
I $E(IOST,1,2)="C-" W @IOF
S L1="VA TIME & ATTENDANCE SYSTEM",L2="PAID PARAMETERS ENTER/EDIT"
W ?((80-$L(L1))/2),L1,!,?((80-$L(L2))/2),L2,!!!!
Q
;
SHODIVAC(OUT) ; DISPLAY POC ACCESS (T&L/NURSE LOCATION) FOR ALL DIVISIONS
;
N DIR,X,Y,DIRUT S DIR(0)="Y",DIR("A")="Show history" D ^DIR
Q:$D(DIRUT)
W @IOF
N HIST,CNT,DIVI
S HIST=Y
D SDHDR
S (CNT,DIVI)=0
F S DIVI=$O(^PRST(456,"B",DIVI)) Q:DIVI'>0!OUT D
. S CNT=CNT+1
. I CNT>1,HIST D SDHDR
. S X=$P($$DIVACC^PRSNUT02(DT,DIVI),U)
. W !
. W $$EXTERNAL^DILFD(456,.01,"",DIVI)
. N FIELDS,STATNUM
. D GETS^DIQ(4,DIVI_",","99","E","FIELDS(",,)
. S STATNUM=FIELDS(4,DIVI_",",99,"E")
. W " (",STATNUM,")"
. W ?32,$S(X="N":"Nurse Location",X="T":"T&L Unit",1:"None")
. W ?55,"(Current)"
. I HIST D ACCHIST(DIVI) W !!! S OUT=$$ASK^PRSLIB00()
I 'HIST W !!! S OUT=$$ASK^PRSLIB00()
Q
ACCHIST(DIVI) ; SHOW HISTORY OF POC ACCESS (T&L/NURSE LOC) FOR A DIVISION
;
N DPI,PPE,AP,PPE
S DPI=$O(^PRST(456,"B",DIVI,0))
Q:DPI'>0
S PPE=""
F S PPE=$O(^PRST(456,DPI,1,"C",PPE)) Q:PPE="" D
. S AP=$O(^PRST(456,DPI,1,"C",PPE,""))
. W !?32,$S(AP="N":"Nurse Location",1:"T&L Unit")
. W ?57,PPE
Q
SDHDR ; SHOW DIVISION HEADER
W @IOF,!!!
W !?30,"DATA ENTRY/APPROVAL",?55,"EFFECTIVE"
W !," DIVISION",?30,"ACCESS TO NURSE VIA",?55,"PAY PERIOD"
W !,"===============",?29,"======================",?54,"============"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNCAPE 5434 printed Nov 22, 2024@17:37:08 Page 2
PRSNCAPE ;WOIFO/DWA - PAID PARAMETER ENTER/EDIT ;07/30/09
+1 ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ; Key variables used in this routine:
+7 ;
+8 ; PPI,PPE,PPST = Current pay period internal value, external
+9 ; value and start date
+10 ; LPPE,LPST = Last pay period external value and start date
+11 ; NPPE,NPST = Next pay period external value and start date
+12 ;
+13 ; IENS = Internal entry number of selected institution
+14 ; IENS2 = External value of selected institution
+15 ;
+16 ; PRSFDA = A name spaced FileMan Data Array
+17 ; PAYPD = External value of selected effective pay period
+18 ; PPDI = Internal entry number of selected effective
+19 ; pay period
+20 ;
+21 ;
EN ; Entry point for PAID Application Parameter Edit
+1 NEW OUT
SET OUT=0
DO SHODIVAC(.OUT)
if OUT
QUIT
+2 KILL DIC
+3 NEW PPI,PPE,PPST,LPPE,LPST,NPPE,NPST,IENS,IENS2,PRSFDA,PAYPD,PPDI
+4 NEW X1,X2,X,Y,ORIGPP,NAM,NAM2
+5 SET PPI=$PIECE($GET(^PRST(458,"AD",DT)),"^")
+6 IF 'PPI
WRITE !!,"Current Pay Period must be open for testing. Quitting."
QUIT
+7 SET PPE=$PIECE(^PRST(458,PPI,0),"^")
+8 SET LPPE=$PIECE(^PRST(458,PPI-1,0),"^")
+9 SET NPPE=$EXTRACT($$NXTPP^PRSAPPU(PPE),3,7)
+10 SET PPST=$PIECE(^PRST(458,PPI,1),"^")
+11 SET LPST=$PIECE(^PRST(458,PPI-1,1),"^")
+12 SET X1=PPST
SET X2=14
DO C^%DTC
SET NPST=X
+13 DO HDR
+14 NEW DIC,X,Y,DUOUT,DTOUT,DLAYGO
+15 SET DIC="^PRST(456,"
SET DIC(0)="ALEQMZ"
SET DLAYGO=456
SET DIC("A")="Select Institution: "
+16 DO ^DIC
+17 if $DATA(DUOUT)!$DATA(DTOUT)!(+Y'>0)
QUIT
+18 SET IENS=+Y
SET IENS2=$PIECE(Y,U,2)
PPDS ; Set the effective pay period
+1 SET X=PPST
DO DTP^PRSAPPU
+2 WRITE !!!,"C = Current Pay Period beginning "_Y
+3 SET X=LPST
DO DTP^PRSAPPU
+4 WRITE !,"L = Last Pay Period beginning "_Y
+5 SET X=NPST
DO DTP^PRSAPPU
+6 WRITE !,"N = Next Pay Period beginning "_Y,!
+7 NEW DIR,DIRUT,Y,PRSDT
+8 SET DIR(0)="SB^C:Current;N:Next;L:Last"
SET DIR("A")="Select Effective Pay Period; Current, Next, Last"
+9 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+10 WRITE !!
+11 SET PAYPD=$SELECT(Y="C":PPE,Y="N":NPPE,1:LPPE)
+12 ;
+13 SET PRSDT=$SELECT(Y="C":PPST,Y="N":NPST,1:LPST)
+14 ;
+15 SET PPDI=$ORDER(^PRST(456,IENS,1,"B",PAYPD,0))
+16 ;
+17 SET NAM=$$DIVACC^PRSNUT02(PRSDT,IENS2)
+18 SET ORIGPP=$PIECE(NAM,U,2)
+19 SET NAM=$PIECE(NAM,U)
+20 SET NAM2=$SELECT(NAM="N":"T",1:"N")
+21 ;
+22 ; If no existing entry, set one up, otherwise Update existing entry
+23 IF PPDI'>0
Begin DoDot:1
+24 DO NA1
End DoDot:1
+25 IF '$TEST
Begin DoDot:1
+26 WRITE !!,"The Nurse Access Method for "_$$EXTERNAL^DILFD(456,.01,"",IENS2)_" pay period "_PAYPD_" is currently set to ",!,$$EXTERNAL^DILFD(456.05,1,"",NAM)_". Do you wish to change it?",!!
+27 NEW DIR,Y,DIRUT
+28 SET DIR(0)="Y"
SET DIR("B")="Yes"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+29 IF Y=0
WRITE " No changes made, quitting.",!!
QUIT
+30 SET NAM=NAM2
+31 SET PRSFDA(456.05,PPDI_","_IENS_",",1)=NAM
+32 DO FILE^DIE("","PRSFDA","")
DO MSG^DIALOG()
+33 WRITE !!,"The Nurse Access Method for "_$$EXTERNAL^DILFD(456,.01,"",IENS2)_" has been successfully changed to ",!,$$EXTERNAL^DILFD(456.05,1,"",NAM)_" Effective Pay Period "_PAYPD_".",!!
+34 QUIT
End DoDot:1
+35 QUIT
+36 ;
+37 ;
NA1 ; Create a new sub-record and set nurse access parameter
+1 ;
+2 NEW STOP,PPDI
+3 SET STOP=0
+4 NEW DIR,Y,DIRUT
+5 IF ORIGPP'=""
Begin DoDot:1
+6 WRITE !!,"The Nurse Access Method for "_$$EXTERNAL^DILFD(456,.01,"",IENS2)_" pay period "_PAYPD_" is currently set to ",!,$$EXTERNAL^DILFD(456.05,1,"",NAM)_". Do you wish to change it?",!!
Begin DoDot:2
End DoDot:2
+7 SET DIR(0)="Y"
SET DIR("B")="Yes"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+8 IF Y=0
WRITE " No changes made, quitting.",!!
SET STOP=1
QUIT
+9 SET NAM=NAM2
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 SET DIR(0)="SB^N:Nurse Location;T:T&L Unit"
SET DIR("A")="Select Nurse Access Method; Nurse Location or T&L Unit"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+12 SET NAM=X
End DoDot:1
+13 ;
+14 if STOP
QUIT
+15 NEW PRSFDA,PRSIENS,PPDI
+16 SET PRSFDA(456.05,"+2,"_IENS_",",.01)=PAYPD
+17 DO UPDATE^DIE("","PRSFDA","PRSIENS")
DO MSG^DIALOG()
+18 SET PPDI=PRSIENS(2)
+19 SET PRSFDA(456.05,PPDI_","_IENS_",",1)=NAM
+20 DO FILE^DIE("","PRSFDA","")
DO MSG^DIALOG()
+21 WRITE !!,"The Nurse Access Method for "_$$EXTERNAL^DILFD(456,.01,"",IENS2)_" has been successfully set to ",!,$$EXTERNAL^DILFD(456.05,1,"",NAM)_" Effective Pay Period "_PAYPD_".",!!
+22 QUIT
+23 ;
+24 ;
+25 ;
HDR ;
+1 NEW L1,L2
+2 IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+3 SET L1="VA TIME & ATTENDANCE SYSTEM"
SET L2="PAID PARAMETERS ENTER/EDIT"
+4 WRITE ?((80-$LENGTH(L1))/2),L1,!,?((80-$LENGTH(L2))/2),L2,!!!!
+5 QUIT
+6 ;
SHODIVAC(OUT) ; DISPLAY POC ACCESS (T&L/NURSE LOCATION) FOR ALL DIVISIONS
+1 ;
+2 NEW DIR,X,Y,DIRUT
SET DIR(0)="Y"
SET DIR("A")="Show history"
DO ^DIR
+3 if $DATA(DIRUT)
QUIT
+4 WRITE @IOF
+5 NEW HIST,CNT,DIVI
+6 SET HIST=Y
+7 DO SDHDR
+8 SET (CNT,DIVI)=0
+9 FOR
SET DIVI=$ORDER(^PRST(456,"B",DIVI))
if DIVI'>0!OUT
QUIT
Begin DoDot:1
+10 SET CNT=CNT+1
+11 IF CNT>1
IF HIST
DO SDHDR
+12 SET X=$PIECE($$DIVACC^PRSNUT02(DT,DIVI),U)
+13 WRITE !
+14 WRITE $$EXTERNAL^DILFD(456,.01,"",DIVI)
+15 NEW FIELDS,STATNUM
+16 DO GETS^DIQ(4,DIVI_",","99","E","FIELDS(",,)
+17 SET STATNUM=FIELDS(4,DIVI_",",99,"E")
+18 WRITE " (",STATNUM,")"
+19 WRITE ?32,$SELECT(X="N":"Nurse Location",X="T":"T&L Unit",1:"None")
+20 WRITE ?55,"(Current)"
+21 IF HIST
DO ACCHIST(DIVI)
WRITE !!!
SET OUT=$$ASK^PRSLIB00()
End DoDot:1
+22 IF 'HIST
WRITE !!!
SET OUT=$$ASK^PRSLIB00()
+23 QUIT
ACCHIST(DIVI) ; SHOW HISTORY OF POC ACCESS (T&L/NURSE LOC) FOR A DIVISION
+1 ;
+2 NEW DPI,PPE,AP,PPE
+3 SET DPI=$ORDER(^PRST(456,"B",DIVI,0))
+4 if DPI'>0
QUIT
+5 SET PPE=""
+6 FOR
SET PPE=$ORDER(^PRST(456,DPI,1,"C",PPE))
if PPE=""
QUIT
Begin DoDot:1
+7 SET AP=$ORDER(^PRST(456,DPI,1,"C",PPE,""))
+8 WRITE !?32,$SELECT(AP="N":"Nurse Location",1:"T&L Unit")
+9 WRITE ?57,PPE
End DoDot:1
+10 QUIT
SDHDR ; SHOW DIVISION HEADER
+1 WRITE @IOF,!!!
+2 WRITE !?30,"DATA ENTRY/APPROVAL",?55,"EFFECTIVE"
+3 WRITE !," DIVISION",?30,"ACCESS TO NURSE VIA",?55,"PAY PERIOD"
+4 WRITE !,"===============",?29,"======================",?54,"============"
+5 QUIT
+6 ;
