Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRSNEE

PRSNEE.m

Go to the documentation of this file. 
  1. PRSNEE ;WOIFO/PLT - Enter Nurse POC Data Entry ; 08/14/2009  7:56 AM
  1.  ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  QUIT
  1.  ;
  1. ENT ;option entry
  1.  N A,X,Y
  1.  N PRSNCR,PRSNG,PRSNDT,PPI,PRSNDAY,PRSNPP,PRSNEW,PRSNGLB,PRSNGA,PRSNGB,DFN,PRSNX
  1.  ;prsncr="" if poc a/e, =1 if correct release, =eta if post employee time
  1.  S PRSNCR=""
  1.  D ACCESS^PRSNUT02(.A,"E",DT,"")
  1.  I $P($G(A(0)),U,2)="E" D  Q
  1.  .W !,$P(A(0),U,3)
  1.  S PRSNG=A(0)_"^"_$O(A(0))_"^"_A($O(A(0))) K A
  1.  S %DT="AEPX",%DT("A")="Enter POC Data for Date: ",%DT("B")="T-1" D ^%DT G:Y<1 EXIT
  1.  S PRSNDT=Y,Y=$G(^PRST(458,"AD",Y)),PPI=$P(Y,"^",1),PRSNDAY=$P(Y,"^",2)
  1.  I PPI="" D EN^DDIOL("Pay Period is Not Open Yet!") G EXIT
  1.  ;entry from tag nurse for eta
  1. PPADD ;
  1.  N PRSNUR
  1.  S PRSNPP=$P(^PRST(458,PPI,0),U)_U_$P(^(2),U,PRSNDAY)
  1.  ;add new ppi entry in file 451
  1.  I '$D(^PRSN(451,PPI)) K X,Y S X=$P(PRSNPP,U) D ADD^PRSU1B1(.X,.Y,"451",PPI) S:Y PRSNEW=1
  1.  I '$D(^PRSN(451,PPI)) W !,"File - POC DAILY TIME RECORDS is in use, try it later!" G EXIT
  1.  ;if from entry point nurse called from eta post employee time option
  1.  I PRSNCR="ETA" D POST G EXIT
  1. Q1 S Y(1)="Answer YES if you want all Nurses brought up for whom no data has been entered." D YN^PRSU1A(.X,.Y,"Would you like to enter the POC RECORDs in alphabetical order","","Yes")
  1.  ;+prsng=1 - for alpha order, =0 for one nurse
  1.  S $P(PRSNG,U)=Y G ONE:Y=0,EXIT:Y["^"
  1.  ;for group of location or t&l
  1.  S PRSNGLB=$S($P(PRSNG,U,2)="N":$NA(^NURSF(211.8,"D",$P(PRSNG,U,7))),1:$NA(^PRSPC("ATL"_$P(PRSNG,U,3))))
  1.  S PRSNGA="",PRSNX=0
  1.  F  S PRSNGA=$O(@PRSNGLB@(PRSNGA)) QUIT:PRSNGA=""  D  QUIT:PRSNX
  1.  . S PRSNGB=0
  1.  . F  S PRSNGB=$O(@PRSNGLB@(PRSNGA,PRSNGB)) QUIT:'PRSNGB  D  QUIT:PRSNX
  1.  .. I $P(PRSNG,U,2)="N",+$P(PRSNG,U,4)'=+$$PRIMLOC^PRSNUT03(PRSNGB) Q
  1.  .. S DFN=$S($P(PRSNG,U,2)="N":+$G(^VA(200,PRSNGB,450)),1:PRSNGB)
  1.  .. D POST
  1.  .. ;don't ask question if not a nurse.  That check needs to stay in the POST subroutine beause it is called from other parts of this program.
  1.  .. Q:'PRSNUR
  1.  .. N DIR,Y,DIRUT
  1.  .. S DIR(0)="Y",DIR("B")="Yes",DIR("A")="Continue to next Nurse"
  1.  .. D ^DIR
  1.  .. S PRSNX=$S(Y=1:0,1:1)
  1.  . QUIT
  1.  G EXIT
  1.  ;
  1. ONE ;selecting a nurse
  1.  S Y=$$PICKNURS^PRSNUT03($P(PRSNG,U,2),$P(PRSNG,U,4)) G EXIT:Y<1
  1.  S DFN=+Y D POST G ONE
  1.  ;
  1. EXIT QUIT
  1.  ;
  1. POST ;start poc posting
  1.  N PRSNQ,PRSNLOC,PRSNLOC,PRSNPC,PRSNVER,PRSNQ,PRSNTD,PRSNTM
  1.  S PRSNQ="",PRSNUR=$$ISNURSE^PRSNUT01(DFN) QUIT:'PRSNUR
  1.  S $P(PRSNUR,U,5)=$$EXTERNAL^DILFD(451.1,3,,$P(PRSNUR,U,4),)
  1.  S PRSNEW=+$G(PRSNEW),PRSNVER=1
  1.  ;check pp status if not in alpha mode
  1.  I $P($G(^PRSN(451,PPI,"E",DFN,0)),U,2)]"",$P(^(0),U,2)'="E" QUIT:PRSNG  S A=$P(^(0),U,2) D  QUIT
  1.  . W !!,"The POC Record has a status - ",$S(A="A":"Approved, ask Coordinator to return the record for editing.",1:"Released, use the Correct Released Nurse POC Data option for correcting.")
  1.  . QUIT
  1.  S PRSNLOC=$$DFTLOC(PPI,DFN)
  1.  ;quit if in alpha mode
  1.  K PRSNPC I $D(^PRSN(451,PPI,"E",DFN,"D",PRSNDAY,"V",PRSNVER)) QUIT:PRSNG  D SMAN QUIT
  1.  ;get default time segments array prsnpc of poc time segments from eta
  1.  D ETAPOC^PRSNEE0
  1.  ;quit if by group, no eta posted and tour is day off or intermittens
  1.  I PRSNG,'PRSNPC,"1 3 4"[$P(PRSNPC,U,2) QUIT
  1.  W:PRSNG !!,"Nurse: ",PRSNGA,"  (",$P(PRSNUR,U,5),")",?50,$P(PRSNLOC,U,3)
  1.  ;
  1.  ;quit if eta posted, poc with eta default but no tour/exceptions
  1. ADD I PRSNPC,PRSNQ!$P(PRSNQ,U,3),$O(PRSNPC(""))="" QUIT
  1.  ;add nurse in subfile# 451.09 of file #451 with pp-status e
  1.  I '$D(^PRSN(451,PPI,"E",DFN)) K X,Y S X=DFN,X("DR")="1////E" D ADD^PRSU1B1(.X,.Y,"451;;"_PPI_";9~451.09;^PRSN(451,PPI,""E"",",DFN) S:Y $P(PRSNEW,U,2)=1
  1.  I '$D(^PRSN(451,PPI,"E",DFN)) W !,"Nurse POC file in use, try it later!" QUIT
  1.  ;add day # in subfile #451.99 in subfile #451.09
  1.  I '$D(^PRSN(451,PPI,"E",DFN,"D",PRSNDAY)) K X,Y S X=PRSNDAY D ADD^PRSU1B1(.X,.Y,"451;;"_PPI_"~451.09;;"_DFN_";9~451.99;^PRSN(451,PPI,""E"",DFN,""D"",",PRSNDAY) S:Y $P(PRSNEW,U,3)=1
  1.  I '$D(^PRSN(451,PPI,"E",DFN,"D",PRSNDAY)) W !,"Nurse POC file in use, try it later!" QUIT
  1.  ;add version # in subfile #451.999 in subfile #451.99
  1.  I '$D(^PRSN(451,PPI,"E",DFN,"D",PRSNDAY,"V",PRSNVER)) K X,Y S X=PRSNVER D ADD^PRSU1B1(.X,.Y,"451;;"_PPI_"~451.09;;"_DFN_";~451.99;;"_PRSNDAY_";9~451.999;^PRSN(451,PPI,""E"",DFN,""D"",PRSNDAY,""V"",",PRSNVER) S:Y $P(PRSNEW,U,4)=1
  1.  I '$D(^PRSN(451,PPI,"E",DFN,"D",PRSNDAY,"V",PRSNVER)) W !,"Nurse POC file in use, try it later!" QUIT
  1.  D SMAN
  1.  QUIT
  1.  ;
  1.  ;
  1. SMAN ;start screenman
  1.  N PRSNID,DDSFILE,DR,DA,DDSPAGE,DDSPARM,DDSCHANG,DDSSAVE,DIMSG,DTOUT,REASCD,REASTOP
  1.  L +^PRSN(451,PPI,"E",DFN):0 E  W !!,"File is in use, Try it later!" D:$P(PRSNEW,U,4) EDVDEL QUIT
  1.  S:PRSNCR=1 PRSNLOC=$$DFTLOC(PPI,DFN)
  1.  ;add poc data prsnpc array time segemnts in file #451.9999 of file #451
  1.  ;COMMENT OUT SKIPPING OF POC SCREEN, MAKE THEM LOOK AT IT AND PF1-E OUT
  1.  I $O(PRSNPC(""))]"",PRSNLOC D ADDTS^PRSNEE0
  1.  ;prsnid = 1^ name ^2 staion # ^3 t&l ^4 ss# ^5 defaul location ^6 poc status
  1.  S PRSNID=$P(^PRSPC(DFN,0),U),$P(PRSNID,U,2,4)=$P(^PRSPC(DFN,0),U,7,9),$P(PRSNID,U,5)=$P(PRSNLOC,U,3)
  1.  S $P(PRSNID,U,6)=$S('PRSNCR:$P(^PRSN(451,PPI,"E",DFN,0),U,2),1:$P(^PRSN(451,PPI,"E",DFN,"D",PRSNDAY,0),U,2))
  1.  S $P(PRSNID,U,6)=$S($P(PRSNID,U,6)="E":"Entered",1:"New")
  1.  ;get displaying tour of duty of the day and the 1 or 2 day tour data
  1.  S PRSNTD=$$TOUR(PPI,DFN,PRSNDAY),PRSNTM=$$PSTOUR^PRSNEE0(PPI,DFN,PRSNDAY)
  1.  S DA=PRSNVER,DA(1)=PRSNDAY,DA(2)=DFN,DA(3)=PPI
  1.  S DDSFILE(1)=451.999,DDSFILE(2)=451.99,DDSFILE(3)=451.09,DDSFILE=451,DDSPAGE=1
  1.  S REASCD="",REASTOP=0
  1.  S DR="[PRSN DAILY TIME RECORDS A/E/D]",DDSPARM="CS" D ^DDS
  1.  ;save and change post action after dds call
  1. EDVDEL ;if no save and no change, delete new added entries before dds call
  1.  ;delete e,d, v multiple field records
  1.  I $P(PRSNEW,U,4),'$G(DDSSAVE),'$G(DDSCHANG) D
  1.  . N PRSNA
  1.  . S PRSNA="451;;"_PPI_";9~451.09;^PRSN(451,PPI,""E"",;"_DFN
  1.  . I $P(PRSNEW,U,2) K X D DELETE^PRSU1B1(.X,PRSNA) QUIT
  1.  . S $P(PRSNA,"~",3)="451.99;^PRSN(451,PPI,""E"",DFN,""D"",;"_PRSNDAY
  1.  . I $P(PRSNEW,U,3) K X D DELETE^PRSU1B1(.X,PRSNA) QUIT
  1.  . S $P(PRSNA,"~",4)="451.999;^PRSN(451,PPI,""E"",DFN,""D"",PRSNDAY,""V"",;"_PRSNVER
  1.  . I $P(PRSNEW,U,4) K X D DELETE^PRSU1B1(.X,PRSNA)
  1.  . QUIT
  1.  ;changed
  1.  I $G(DDSCHANG)=1 D
  1.  . QUIT
  1.  ;saved
  1.  I $G(DDSSAVE)=1 D
  1.  . ;add correction released status 'e' in day # multiple
  1.  . I PRSNCR,$P(PRSNEW,U,4) D EDIT^PRSU1B(.X,"451;;"_PPI_"~451.09;;"_DFN_";9~451.99;^PRSN(451,PPI,""E"",DFN,""D"",;"_PRSNDAY,"1////E","")
  1.  . QUIT
  1. SMANEXT L -^PRSN(451,PPI,"E",DFN)
  1.  QUIT
  1.  ;
  1. REASON(CD,STOP) ;
  1.  N CDIEN,DESC,VAL,SEQ,I
  1.  S VAL=""
  1.  I STOP Q VAL
  1.  S CD=$O(^PRSN(451.6,"B",CD))
  1.  I CD="" S STOP=1 Q VAL
  1.  S CDIEN=$O(^PRSN(451.6,"B",CD,""))
  1.  S DESC=$P($G(^PRSN(451.6,CDIEN,0)),U,2)
  1.  S VAL=CD_" - "_DESC
  1.  Q VAL
  1.  ;
  1. WORKTYPH ;
  1.  N CDIEN,DESC,VAL,SEQ,I,COL
  1.  S CD="",SEQ=0
  1.  F I=0:1 S CD=$O(^PRSN(451.5,"B",CD)) Q:CD=""  D
  1.  .S CDIEN=$O(^PRSN(451.5,"B",CD,""))
  1.  .S DESC=$P($G(^PRSN(451.5,CDIEN,0)),U,2)
  1.  .S COL=I#3
  1.  .I COL=0 S SEQ=SEQ+1
  1.  .S VAL(SEQ)=$G(VAL(SEQ))
  1.  .S VAL(SEQ)=VAL(SEQ)_$J("",27*COL-$L(VAL(SEQ)))_CD_" - "_DESC
  1.  D HLP^DDSUTL(.VAL)
  1.  Q
  1.  ;
  1. TOUR(PPI,DFN,DAY) ;ef - tour of duty of the nurse
  1.  N Y1,Y2,Y3,Y31,Y4,TC,L1,A1,L3,PRSNTD
  1.  S PRSNTD="" D F1^PRSADP1
  1.  QUIT Y31
  1.  ;
  1.  ;return ^1 = "", ^2=ien of file #44, ^3=hospital location name
  1. DFTLOC(PPI,DFN) ;ef - nurse default location of the ppi
  1.  N A
  1.  S A=$P($G(^PRSN(451,PPI,"E",DFN,0)),U,6)
  1.  QUIT:A +A_"^^"_$S(A:$P($G(^SC(+$G(^NURSF(211.4,+A,0)),0)),U),1:"")
  1.  QUIT $$PRIMLOC^PRSNUT03(+$G(^PRSPC(DFN,200)))
  1.  ;
  1.  ;ppi=ien of file #458, dfn=ien of file #450, prsnday=day #, prsndt=fileman date of day #
  1. NURSE(PPI,DFN,PRSNDAY,PRSNDT) ;entry point from eta post employee time option
  1.  N PRSNCR,PRSNG,PRSNPP,PRSNEW,PRNGLB,PRSNGA,PRSNGB,PRSNX
  1.  S PRSNCR="ETA",PRSNG=0 G PPADD
  1.  ;
  1.  ;the following line is for testing by d nurse+3*******************
  1.  S PRSNCR="",PRSNEW="",PRSNG=0,PPI=347,DFN=14308,PRSNDAY=3,PRSNVER=2
  1.  S PRSNLOC=$$DFTLOC(PPI,DFN),PRSNPP=$P(^PRST(458,PPI,0),U)_U_$P(^(2),U,PRSNDAY) G SMAN
  1.  ;