NURSUT0 ;HIRMFO/MD,RM,FT-NURS STAFF FILE EDIT UTILITY ; 1/17/03 2:54pm
 ;;4.0;NURSING SERVICE;**1,16,18,33,34,38**;Apr 25, 1997
 ;
 ; Reference to File #452.3 is supported by IA #1400
 ; Reference to ^PRSPC is supported by IA #1402
 ; File #200 is covered by supported reference #10060
 ;
EN1(NURSEMP,NURSDT) ; DETERMINE IF EMPLOYEE HAS ANY ACTIVE ASSIGNMENTS
 ;VARIBLES NURSDT=TODAY, AND NURSEMP=EMPLOYEE POINTER TO FILE 200
 ;ARE PASSED INTO THE ROUTINE AND VARIBLE NURSTAT IS RETURNED=1 IF AN
 ;ACTIVE POSITION EXISTS AND NURSTAT=0 IF NO ACTIVE POSITIONS EXIST.
 ;ACTIVE POSITIONS HAVE A START DATE '>TODAY AND NO VACANCY DATE OR A
 ;VACANCY DATE '<TODAY
 S NURSTAT=0,NURSDT=$P(NURSDT,".") D
 .F NI(1)=0:0 S NI(1)=$O(^NURSF(211.8,"C",+NURSEMP,NI(1))) Q:NI(1)'>0  F NI=0:0 S NI=$O(^NURSF(211.8,"C",+NURSEMP,NI(1),NI)) Q:NI'>0  I +^NURSF(211.8,NI(1),1,NI,0)'>NURSDT&(('+$P(^(0),U,6))!(+$P(^(0),U,6)'<NURSDT)) S NURSTAT=1
 .K NURSDT,NURSEMP,NURI
 .Q
 Q $S(NURSTAT=1:1,1:0)
EN2 ; FIND PRIMARY SERVICE POSITION
 Q:'$D(^NURSF(210,DA,0))  S ID=+^(0) Q:ID'>0  S (NOD1,NOD2,NPSPOS,NPSPOS(0),NPSPOS(1))=""
 I '($P(^NURSF(210,DA,0),U,2)="R") D EN3 G SVPOS
 I $D(^NURSF(211.8,"AE",ID)) F NURSX=0:0 S NURSX=$O(^NURSF(211.8,"AE",ID,1,NURSX)) Q:NURSX'>0  F NURSZ=0:0 S NURSZ=$O(^NURSF(211.8,"AE",ID,1,NURSX,NURSZ)) Q:NURSZ'>0  I +$G(^NURSF(211.8,NURSX,1,NURSZ,0)) D
 .  S NURS("AE",(9999999-+$G(^NURSF(211.8,NURSX,1,NURSZ,0))),NURSX,NURSZ)=""
 .  Q
 I $O(NURS("AE",0)) S NURSX=$O(NURS("AE",0)),NOD1=$O(NURS("AE",NURSX,0)),NOD2=$O(NURS("AE",NURSX,NOD1,0))
SVPOS Q:'$D(^NURSF(211.8,+NOD1,1,+NOD2,0))  S NPNT=$P(^NURSF(211.8,NOD1,1,NOD2,0),U,3) S NPSPOS=$S('$D(^NURSF(211.3,NPNT,0)):"",1:$P(^(0),U)),NPSPOS(0)=NPNT,NPSPOS(1)=$S('$D(^NURSF(211.3,NPNT,0)):"",1:$P(^(0),U,5))
 S SC44DA=+$G(^NURSF(211.8,NOD1,0)),NUR2114D=$O(^NURSF(211.4,"B",SC44DA,0))
 S NPNT(1)=+$P(^NURSF(211.3,NPNT,0),U,7),NURFLAG=1
 ; GET PRODUCT LINE/FACILITY OF PRIMARY POSITION
 S NPSPOS(2)=$S(NPNT(1):$$GET1^DIQ(212.7,NPNT(1),.01,"I"),1:"")
 S (NPSPOS(3),NPSPOS(4))="" I NOD1 D
 .  S NPSPOS(3)=$$EN11^NURSUT3(NOD1)
 .  S NPSPOS(4)=$$EN13^NURSUT3(NOD1)
 K NURS,NURFLAG,NPI,NPNT,NPI1,ID Q
 Q
EN3 ; SELECT FIRST ACTIVE PRIMARY ASSIGNMENT
 S (NOD1,NOD2)="",NURFLAG=0,ID=$S($P($G(^NURSF(210,+DA,0)),U):$P(^(0),U),1:"") Q:ID=""
 F NUI(1)=0:0 S NUI(1)=$O(^NURSF(211.8,"AE",ID,1,NUI(1))) Q:NUI(1)'>0!(NURFLAG=1)  F NUI=0:0 S NUI=$O(^NURSF(211.8,"AE",ID,1,NUI(1),NUI)) Q:NUI'>0!(NURFLAG=1)  D CHECK
 K NUI,ID
 Q
CHECK ;
 I +$P(^NURSF(211.8,NUI(1),1,NUI,0),U)'>DT&(('+$P(^(0),U,6))!($P(^(0),U,6)'<DT)) S NOD1=NUI(1),NOD2=NUI,NOD2(1)=$P(^(0),U) S NURFLAG=1
 Q
EN4 ;SET LOGIC FOR DE XREF OF 211.82 SUBFILE
 S:+$P(NUR,U,3) ^NURSF(211.8,"AD",X,$P(NUR,U,3),DA(1),DA)="" S:+$P(NUR,U,9) ^NURSF(211.8,"AE",X,$P(NUR,U,9),DA(1),DA)="" K NUR
 Q
EN5 ;KILL LOGIC FOR DE XREF 0F 211.82 SUBFILE
 K:+$P(NUR,U,3) ^NURSF(211.8,"AD",X,$P(NUR,U,3),DA(1),DA) K:+$P(NUR,U,9) ^NURSF(211.8,"AE",X,$P(NUR,U,9),DA(1),DA) K NUR
 Q
EN6 ; SELECT MULTIPLE REPORT COPIES
 W !?5,"How many copies of this report are required: 1// " R NCOPY:DTIME
 I NCOPY=U!('$T) S NURQUIT=1 Q
 S:NCOPY="" NCOPY=1 I NCOPY'=+NCOPY!(NCOPY<1)!(NCOPY>20) W !,$C(7),?5,"ANSWER WITH A NUMBER BETWEEN 1 AND 20",!! G EN6
 Q
EN7 ; NURS DEVICE HANDLING/QUEUEING LOGIC
 K ZTSK S %ZIS="Q" S:$G(NURS132) %ZIS("B")=""
 D ^%ZIS K %ZIS K:POP IO("Q") I POP S (NUROUT,NURQUIT)=1 Q
 I IO'=IO(0),$E(IOST)="P",'$D(IO("Q")),'$D(IO("S")),IOST'["P-MESSAGE-HFS" S XQH="NURS-PRINTER QUEUE" W $C(7) D EN^XQH K XQH G EN7
 I $G(NURS132),IOM<132 D ^%ZISC W !,$C(7)," ** THIS REPORT MUST BE SENT TO A 132 COLUMN DEVICE **",! K IO("Q"),IO("C") G EN7
 I '$D(ZTDESC) S ZTDESC=$S($D(ZTRTN):ZTRTN,1:"Unknown NURSING option")
 F X="A*","B*","C*","D*","E*","F*","G*","H*","I*","J*","K*","L*","M*","N*","O*","P*","Q*","R*","S*","T*","U*","V*","W*","Y*","Z*" S ZTSAVE(X)=""
 S NURQUEUE=0 I $D(IO("Q")) K IO("Q"),IO("C") S NURQUEUE=1,ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL D ^%ZTLOAD S NURQUEUE=0 S:'$D(ZTSK) POP=1
 Q
EN8 ; INPUT TRANSFORM FOR 2.1 & 2.5 SUBFIELDS OF FIELD 22.5
 ;OF FILE 210
 S NURS(0)=$S($D(^NURSF(210,DA(1),20,DA,0)):^(0),1:""),NURS("HELP")="DATE MUST BE "_$P("GREATER THAN DATE STARTED OR A VALID DATE ^LESS THAN DATE ENDED OR A VALID DATE ",U,NURS*10=21+1)
 S %DT(0)=+($E("-",NURS*10=21)_$P(NURS(0),U,$E(56,NURS*10=21+1)))
 S NURS(1)=$S(NURS=2.5&%DT(0)=0:1,1:0)
 K:%DT(0)=0 %DT(0) S %DT="E" D ^%DT S X=Y I Y<1 W !?5,NURS("HELP") K X,NURS Q
 S %DT(0)="-"_DT,%DT="E" D ^%DT S X=Y I Y<1 W !?5,"DATE MUST BE A CURRENT OR PAST DATE" K X,NURS Q
 I NURS(1) S $P(^NURSF(210,DA(1),20,DA,0),U,5)=X
 K %DT,NURS
 Q
EN9 ; FIND TOUR OF DUTY FROM STAFF FILE
 D EN3^NURSUT0 S NUR=$S('$D(^NURSF(211.8,+NOD1,1,+NOD2,0)):"",1:$P(^(0),U,10)),NUR(1)=$S('$D(^NURSF(211.6,+NUR,0)):"",1:$P(^(0),U))
 K NOD1,NOD2
 Q
EN11(D0) ; PRINT EMPLOYEE MI REVIEW GROUPS
 S VA200DA=+$G(^NURSF(210,D0,0)),SSN=$P($G(^VA(200,+VA200DA,1)),U,9),PDA=$S(SSN="":0,1:$O(^PRSPC("SSN",SSN,0)))
 I PDA>0 W !,?$S($G(EDIT)=1:0,1:9),"MI REVIEW GROUP: " F D1=0:0 S D1=$O(^PRSPC(PDA,5,D1)) Q:D1'>0  I $G(^PRSPC(PDA,5,D1,0))'="" S PRSE=+$G(^(0)) W ?$S($G(EDIT)=1:18,1:26),$P($G(^PRSE(452.3,+PRSE,0)),U) W:$O(^PRSPC(PDA,5,D1)) !
 Q
EN12(DA) ; PRINT EMPLOYEE SALARY
 N X,Y,DM,D0,DE,DC,DG,DI,DIC,DIEL,DIFLD,DK,DQ,DP,DH,DL,DIE,DR
 S SDA=DA,(PDA,XXX)=0,DA200=+$G(^NURSF(210,DA,0)),SSN=$P($G(^VA(200,+DA200,1)),U,9) S:$G(SSN)'="" PDA=$O(^PRSPC("SSN",SSN,0))
 I PDA>0 S XXX=$P($G(^PRSPC(PDA,0)),U,29),Y=$P($G(^(0)),U,28) D:+Y>0 D^DIQ S $P(XXX,U,2)=Y S DA=SDA K PDA,SSN,DA200
 Q XXX
EN13(DA) ; LATEST PROMOTION DATE
 N X,Y,DM,D0,DE,DC,DG,DI,DIC,DIEL,DIFLD,DK,DQ,DP,DH,DL,DIE,DR
 S SDA=DA,Z=$O(^NURSF(210,DA,9,"AA",0)),Y=(9999999-Z) D:+Y>0 D^DIQ S XXX=Y
 Q XXX