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

NURSUT4.m

Go to the documentation of this file.
  1. NURSUT4 ;HIRMFO/RM-UTILITIES FOR FILE 213.9 ;5/17/93
  1. ;;4.0;NURSING SERVICE;**20,22**;Apr 25, 1997
  1. EN1 ; ENTRY FROM INPUT TRANSFORM FROM FIELDS 10.4 AND 10.5 ON FILE 213.9
  1. K:$L(X)>6!($L(X)<1)!'(X?1"T"!(X?1"N")!(X?1"T+"1.4N)!(X?1"T-"1.4N)!(X?1"N+"1.4N)!(X?1"N-"1.4N)) X
  1. Q
  1. EN2 ; EXECUTABLE HELP FROM OPTION NURAAM-ACU GRADE/STEP CODE LOAD
  1. N DA,Y,X I $G(^NURSF(211.1,0))="" W !,$C(7),"NURS PAY SCALE FILE IS NOT RESIDENT CANNOT CONTINUE!!"
  1. K NUROUT,^TMP("NURCD",$J)
  1. D DISP
  1. W !!,"Enter Grade/Step Code",!,"examples: ",!,"R/E1/5 = Registered Nurse,ENTRY1,Step 5",!,"N/4/7 = Nursing Assistant,GS4,Step 7",!
  1. QUIT K NURTAB,NURS,NURAQ,NUREND,NURP,NSCD,I,NURMAX,NCTR,NURI,NURMI
  1. Q
  1. DISP ;
  1. K NURTAB,NSCD S NCTR=1,NSCD="",NURMAX=0
  1. F I=0:0 S NSCD=$O(^NURSF(211.1,"B",NSCD)) Q:NSCD="" F DA=0:0 S DA=$O(^NURSF(211.1,"B",NSCD,DA)) Q:DA'>0 D
  1. . S NURMAX=NURMAX+1,NSCD(NURMAX)=DA_"^"_NSCD
  1. . Q
  1. S NURSTRT=1,(NUROUT,NURDONE)=0
  1. F D DSP I $G(NURDONE)!$G(NUROUT) Q
  1. Q
  1. DSP ;
  1. W @IOF S NURAQ=$Y
  1. F NURS=NURSTRT:3:NURMAX S NURI=NURS D I $Y>(IOSL+NURAQ-10),NURS'=NURMAX S NURSTRT=NURS+3 Q
  1. . Q:$D(NSCD(NURI))[0
  1. . S NURI(0)=NURI+1,NURI(1)=NURI+2
  1. . W ! W:$G(NSCD(NURI))'="" ?1,$J(NURI,2),". ",$P($G(NSCD(NURI)),U,2) W:$G(NSCD(NURI(0)))'="" ?26,$J(NURI(0),2),". ",$P($G(NSCD(NURI(0))),U,2) W:$G(NSCD(NURI(1)))'="" ?52,$J(NURI(1),2),". ",$P($G(NSCD(NURI(1))),U,2)
  1. . Q
  1. S NURDONE=(NURS=NURMAX)!(NURS+2=NURMAX)
  1. I 'NURDONE W !,"<<More>>"
  1. W !,"Press the return key to continue or '^' to exit: " R NURX:DTIME I NURX="^" S NUROUT=1 Q
  1. G:NURDONE QUIT
  1. S:NURX["?" NURSTRT=1 G DSP:NURX["?"
  1. Q
  1. EN3 ;INPUT TRANSFORM FOR FIELD 8 FILE 211.82
  1. K X W $C(7),!,"*** NOT YET IMPLEMENTED ***"
  1. Q
  1. COMPDAT(D0) ; EXTRINSIC FUNCTION TO RETURN COMPUTED SERVICE COMPUTATION DATE
  1. ; FROM THE EMPLOYEE(#450) FILE
  1. N X,Y,NURY,NURX,NURZ
  1. S (NURCOMP,PRSPCDA)=0,NURX=+$G(^NURSF(210,+D0,0)),NURY=$P($G(^VA(200,+NURX,1)),U,9) S:NURY'="" PRSPCDA=$O(^PRSPC("SSN",NURY,0))
  1. S Y=$S(+PRSPCDA:$P($G(^PRSPC(PRSPCDA,0)),U,31),1:"")
  1. ;I +Y>0 S %DT="" D DD^%DT S NURCOMP=Y
  1. I +Y>0 S NURCOMP=Y
  1. S:NURCOMP=0 NURCOMP="" K PRSPCDA
  1. Q NURCOMP
  1. VALENT ;
  1. S NURSBAD=0 F NURS1=1:1 S NURS2=$P(NURSX,",",NURS1) Q:NURS2="" D VAL0 Q:NURSBAD
  1. Q
  1. VAL0 I +NURS2>NURSMAX!(+NURS2<1) S NURSBAD=1
  1. I NURS2["-",$P(NURS2,"-")'?.N!($P(NURS2,"-",2)'?.N)!(+$P(NURS2,"-",2)>NURSMAX)!(+$P(NURS2,"-",2)<1)!(+NURS2>NURSMAX)!(+NURS2<1) S NURSBAD=1
  1. I NURS2'["-",NURS2'?.N!(+NURS2>NURSMAX)!(+NURS2<1) S NURSBAD=1
  1. I (NURSX["?"!(NURSBAD)) D Q
  1. . W:NURSX'?2"?" !!,?5,$C(7),"Make a selection from the screen display, a range of numbers can be",!,?5,"selected by using a HYPHEN, multiple selections can be made by"
  1. . W !,?5,"separating them by COMMAS, ",$S($G(NURSNALL)'>0:"select ALL ",1:""),"or '^' to exit."
  1. . W:NURSX'?2"?" !,?15,"E.G. 1 1-2 1,3 1-2,4-5 1,3-4"
  1. . W:$G(NURSNALL)'>0 " ALL"
  1. . W !,?22,"Are examples of valid selections" S:NURSX?2."?" NURSSTRT=1
  1. . Q
  1. Q
  1. COMPDISP ; SERVICE COMP DATE DISPLAY
  1. N X,Y
  1. S Y=$$COMPDAT^NURSUT4(D0) D D^DIQ I Y'="" W ?$X+1,Y,?$X+1," (NO EDITING)"
  1. Q