NURSUT3 ;HIRMFO/RM,MD-UTILITIES FOR FILES 210 AND 211.8 ; 3/4/03 10:51am
;;4.0;NURSING SERVICE;**33,38**;Apr 25, 1997
;
; Reference to ^SC is supported by IA #1416
; Reference to File #454.1 is supported by IA #1404
; ^XSEC is covered by supported reference #10076
;
EN1 ; INPUT TRANSFORM FOR THE VACANCY DATE (#3) OF THE OCCUPANCY/TRANS.
; DATE (#2) FIELD OF THE POSITION CONTROL FILE.
S NUR(0)=$P($G(^NURSF(211.8,DA(1),0)),U,1,2)_U_$S($D(^NURSF(211.8,DA(1),1,DA,0)):^(0),1:""),NURSBAD=$S(Y'>+NUR(0):"1^3",1:0)
I 'NURSBAD S $P(NUR(0),U,8)=X D EN3^NURSUT2
K:NURSBAD X D EN4
Q
EN2 ; ENTRY FROM INPUT TRANSFORM FOR 1 & 1.5 SUBFIELDS OF FIELD 27
; OF FILE 210
S NURS(0)=$S($D(^NURSF(210,DA(1),18,DA,0)):^(0),1:""),NURS("HELP")="DATE MUST BE "_$P("GREATER THAN DATE STARTED ^LESS THAN DATE ENDED ",U,NURS*10=10+1),%DT(0)=+($E("-",NURS*10=10)_$P(NURS(0),U,$E(24,NURS*10=10+1)))
K:%DT(0)=0 %DT(0) S %DT="E" D ^%DT S X=Y I Y<1 W !?5,NURS("HELP") K X
K %DT,NURS
Q
EN3 ; ENTRY FROM INPUT TRANSFORM ON SUBFIELD .01 OF SUBFIELD 5.5 OF
; FIELD 27 IN FILE 20
S NURS=0 F D1=0:0 S D1=$O(^NURSF(210,DA(2),18,D1)) Q:D1'>0 F D2=0:0 S D2=$O(^NURSF(210,DA(2),18,D1,1,D2)) Q:D2'>0 I $D(^NURSF(210,DA(2),18,D1,1,D2,0)) S NURS(0)=$P(^(0),U) S:X=$P(NURS(0),U) NURS=1
I '+NURS W !!,$C(7),?5,"NO FUNDS WERE REQUESTED FOR "_$S(X="T":"TRAVEL",X="A":"AIRFARE",X="P":"PER DIEM",1:"REGISTRATION")_":" K X
K NURS
Q
EN4 ; PRINT ERROR MESSAGE BASED ON WHAT IS RETURNED FROM EN3
; INPUT VARIABLES: NURSBAD=$S(0:NO PROB,1:PROB)^$S(1:FTEE>1,2:DUP PRI,
; 3:STARTDT>VACDT,4:DUP)
; SERVICE POS,5:NO PRI)
; ASS:ERR,7:DUP DUTY
; TOURS)
I NURSBAD W !!?5,$C(7) W:'($P(NURSBAD,U,2)=5) "DUE TO CHANGES THAT HAVE BEEN MADE, "
I W $S($P(NURSBAD,U,2)=1:"THE TOTAL FTEE",$P(NURSBAD,U,2)=2:"TWO PRIMARY ASSIGNMENTS EXIST FOR",$P(NURSBAD,U,2)=3:"THE START DATE IS GREATER THAN",$P(NURSBAD,U,2)=4:"DUPLICATE SERVICE POSITIONS ON THE",1:"")
I W $S($P(NURSBAD,U,2)=7:"DUPLICATE DUTY TOURS ON THE",1:"")
I W $S($P(NURSBAD,U,2)=1:"",$P(NURSBAD,U,2)=2:"",$P(NURSBAD,U,2)=3:"",$P(NURSBAD,U,2)=4:"",$P(NURSBAD,U,2)=5:"NO PRIMARY POSITION WAS DESIGNATED, THIS POSITION WILL BE PRIMARY",$P(NURSBAD,U,2)=7:"",1:"")
I W $S($P(NURSBAD,U,2)=1:"",$P(NURSBAD,U,2)=2:"",$P(NURSBAD,U,2)=3:"",$P(NURSBAD,U,2)=4:"",$P(NURSBAD,U,2)=5:"",$P(NURSBAD,U,2)=6:"NO PRIMARY POSITION EXISTS FOR THIS ",$P(NURSBAD,U,2)=7:"",1:"INVALID DATA EXISTS FOR THIS")
I W !?5,$S($P(NURSBAD,U,2)=1:"WOULD BE GREATER THAN 1 FOR THIS ",$P(NURSBAD,U,2)=2:"THIS ",$P(NURSBAD,U,2)=3:"THE VACANCY DATE FOR THIS ",$P(NURSBAD,U,2)=4!($P(NURSBAD,U,2)=7):"SAME LOCATION EXIST FOR THIS ",1:"")
I W:'($P(NURSBAD,U,2)=5) "EMPLOYEE. PLEASE RETRY THE CHANGE.",!
K NURSBAD,NX
Q
EN5 ; ENTRY FROM INPUT TRANSFORM FOR 2 & 3 SUBFIELDS OF FIELD 24
; OF FILE 210
S NURS(0)=$S($D(^NURSF(210,DA(1),12,DA,0)):^(0),1:""),NURS("HELP")="DATE MUST BE "_$P("GREATER THAN DATE STARTED ^LESS THAN DATE ENDED ",U,NURS*10=20+1),%DT(0)=+($E("-",NURS*10=20)_$P(NURS(0),U,$E(23,NURS*10=20+1)))
S:%DT(0)=0 %DT(0)=2500101 ;this check stops erroneous years from being entered if user responds with 010100 and FileMan returns 1/1/1900
K:%DT(0)=0 %DT(0) S %DT="E" D ^%DT S X=Y I Y<1 W !?5,NURS("HELP") K X
K %DT,NURS
Q
EN6(DA) ; SCREEN IF EMPLOYEE IS AUTHORIZED TO VIEW THIS LOCATION
; VARIABLES ARE SET BASED ON DIC("S") TO FILE 210.
;
S NURSZORT=1
N NURNODE4,NUR200DA,NUR21182,NURDATA,NURSSEE
S NUR200DA=+$G(^NURSF(210,+Y,0)) I NUR200DA'>0 S NURSZORT=0
I NURSZORT D
. I $G(NURSZAP)>6 D Q:'NURSZORT ; Check location security.
. . S NURSZORT=0
. . S NURNODE4=0 F S NURNODE4=$O(^NURSF(211.8,"C",NUR200DA,NURNODE4)) Q:NURNODE4'>0 D Q:NURSZORT
. . . S NUR21182=0 F S NUR21182=$O(^NURSF(211.8,"C",NUR200DA,NURNODE4,NUR21182)) Q:NUR21182'>0 D Q:NURSZORT
. . . . S NURDATA=$G(^NURSF(211.8,NURNODE4,1,NUR21182,0)) Q:NURDATA=""
. . . . Q:$P(NURDATA,U)=""!($P(NURDATA,U)>DT)!($P(NURDATA,U,6)'=""&($P(NURDATA,U,6)'>DT))
. . . . S NURSZORT=1 D EN3^NURSAUTL
. . . . Q
. . . Q
. . Q
. D EN2^NURSAUTL:$G(NURSZAP) ; Check service position security.
. Q
Q +$G(NURSZORT)
;
EN7(DUZ) ; PRSE TRAIN SECURITY KEY CHECK
Q $S($D(^XUSEC("PRSE TRAIN",DUZ)):1,1:0)
EN8(DUZ) ; PRSE SUP SECURITY KEY CHECK
Q $S($D(^XUSEC("PRSE SUP",DUZ)):1,1:0)
EN9(DUZ) ; PRSE CORD SECURITY KEY CHECK
Q $S($D(^XUSEC("PRSE CORD",DUZ)):1,1:0)
EN10(DUZ) ;
I NURSZAP>0,+$$EN8^NURSUT3($G(DUZ)) S NURSZAP=0 Q
I NURSZAP>0,+$$EN9^NURSUT3($G(DUZ)) S NURSZAP=0 Q
I NURSZAP>7,+$$EN7^NURSUT3($G(DUZ)) S NURSZAP=7
Q
EN11(DA) ; GET FACILITY WITH POSITION CONTROL IEN IN THE NURS POSITION
; CONTROL 211.8 FILE. THE VALUE OF THE FUNCTION WILL BE "" IF THERE
; IS NO FACILITY ASSOCIATED WITH THIS HOSPITAL LOCATION, OR THE
; FREE TEXT VALUE OF THE FACILITY
S XXX="",DIC44DA=+$$GET1^DIQ(211.8,DA,.01,"I")
I DIC44DA S DIC4DA=+$$GET1^DIQ(44,DIC44DA,3,"I") I DIC4DA S XXX=$$GET1^DIQ(4,+DIC4DA,.01,"I")
S:XXX="" XXX=$S($G(NURMDSW):" BLANK",$G(^NURSA(213.2,1,0)):$$GET1^DIQ(4,+$G(^NURSA(213.2,1,0)),.01,"I"),1:"")
K DIC44DA,DIC4DA
Q XXX
EN12(DA) ; GET FACILITY WITH IEN FROM THE NURS LOCATION 211.4 FILE
; THE VALUE OF THE FUNCTION WILL BE " BLANK" IF THERE IS NO FACILITY ASSOCIATED
; WITH THIS NURS LOCATION OR THE FREE TEXT VALUE OF THE FACILITY
S XXX="",DIC4DA=+$P($G(^SC(+$G(^NURSF(211.4,+DA,0)),0)),U,4),XXX=$$GET1^DIQ(4,+DIC4DA,.01,"I") S:XXX="" XXX=" BLANK" K DIC4DA
Q XXX
EN13(NOD1) ; GET PRODUCT LINE OF PRIMARY NURS LOCATIO WITH IEN FROM THE
; POSITION CONTROL FILE THE VALUE OF THE FUNCTION WILL BE " BLANK
; IF THERE IS NO PRODUCT LINE ASSOCIATED WITH THIS NURS LOCATION OR THE
; FREE TEXT VALUE OF THE PRODUCT LINE
N NURUNIT,SC44DA,NUR2127 S SC44DA=+$G(^NURSF(211.8,NOD1,0)),NURUNIT=$O(^NURSF(211.4,"B",SC44DA,0))
S XXX=" BLANK",NUR2127=+$P($G(^NURSF(211.4,+NURUNIT,1)),U,4) I NUR2127 S XXX=$$GET1^DIQ(212.7,+NUR2127,.01,"I")
Q XXX
GETSER() ; THIS PROCEDURE WILL RETURN THE VALUE FOR NURSING IN THE
; PAID COST CENTER ORGANIZATION CODE (454.1) FILE. THE VALUE
; OF THE FUNCTION WILL BE "" IF THERE ARE NO NURSING ENTRIES, OR
; A LIST OF NURSING ENTRY IEN's SEPARATED BY ^'s.
N FXN
S FXN(1)=$O(^PRSP(454.1,"B","NURSING",0))
S FXN(2)=$O(^PRSP(454.1,"B","NURSING SERVICE",0))
I FXN(1)!FXN(2) S FXN=U_$S(FXN(1):FXN(1)_U,1:"")_$S(FXN(2):FXN(2)_U,1:"")
E S FXN=""
Q FXN
NURSUT3 ;HIRMFO/RM,MD-UTILITIES FOR FILES 210 AND 211.8 ; 3/4/03 10:51am
+1 ;;4.0;NURSING SERVICE;**33,38**;Apr 25, 1997
+2 ;
+3 ; Reference to ^SC is supported by IA #1416
+4 ; Reference to File #454.1 is supported by IA #1404
+5 ; ^XSEC is covered by supported reference #10076
+6 ;
EN1 ; INPUT TRANSFORM FOR THE VACANCY DATE (#3) OF THE OCCUPANCY/TRANS.
+1 ; DATE (#2) FIELD OF THE POSITION CONTROL FILE.
+2 SET NUR(0)=$PIECE($GET(^NURSF(211.8,DA(1),0)),U,1,2)_U_$SELECT($DATA(^NURSF(211.8,DA(1),1,DA,0)):^(0),1:"")
SET NURSBAD=$SELECT(Y'>+NUR(0):"1^3",1:0)
+3 IF 'NURSBAD
SET $PIECE(NUR(0),U,8)=X
DO EN3^NURSUT2
+4 IF NURSBAD
KILL X
DO EN4
+5 QUIT
EN2 ; ENTRY FROM INPUT TRANSFORM FOR 1 & 1.5 SUBFIELDS OF FIELD 27
+1 ; OF FILE 210
+2 SET NURS(0)=$SELECT($DATA(^NURSF(210,DA(1),18,DA,0)):^(0),1:"")
SET NURS("HELP")="DATE MUST BE "_$PIECE("GREATER THAN DATE STARTED ^LESS THAN DATE ENDED ",U,NURS*10=10+1)
SET %DT(0)=+($EXTRACT("-",NURS*10=10)_$PIECE(NURS(0),U,$EXTRACT(24,NURS*10=10+1)))
+3 IF %DT(0)=0
KILL %DT(0)
SET %DT="E"
DO ^%DT
SET X=Y
IF Y<1
WRITE !?5,NURS("HELP")
KILL X
+4 KILL %DT,NURS
+5 QUIT
EN3 ; ENTRY FROM INPUT TRANSFORM ON SUBFIELD .01 OF SUBFIELD 5.5 OF
+1 ; FIELD 27 IN FILE 20
+2 SET NURS=0
FOR D1=0:0
SET D1=$ORDER(^NURSF(210,DA(2),18,D1))
IF D1'>0
QUIT
FOR D2=0:0
SET D2=$ORDER(^NURSF(210,DA(2),18,D1,1,D2))
IF D2'>0
QUIT
IF $DATA(^NURSF(210,DA(2),18,D1,1,D2,0))
SET NURS(0)=$PIECE(^(0),U)
IF X=$PIECE(NURS(0),U)
SET NURS=1
+3 IF '+NURS
WRITE !!,$CHAR(7),?5,"NO FUNDS WERE REQUESTED FOR "_$SELECT(X="T":"TRAVEL",X="A":"AIRFARE",X="P":"PER DIEM",1:"REGISTRATION")_":"
KILL X
+4 KILL NURS
+5 QUIT
EN4 ; PRINT ERROR MESSAGE BASED ON WHAT IS RETURNED FROM EN3
+1 ; INPUT VARIABLES: NURSBAD=$S(0:NO PROB,1:PROB)^$S(1:FTEE>1,2:DUP PRI,
+2 ; 3:STARTDT>VACDT,4:DUP)
+3 ; SERVICE POS,5:NO PRI)
+4 ; ASS:ERR,7:DUP DUTY
+5 ; TOURS)
+6 IF NURSBAD
WRITE !!?5,$CHAR(7)
IF '($PIECE(NURSBAD,U,2)=5)
WRITE "DUE TO CHANGES THAT HAVE BEEN MADE, "
+7 IF $TEST
WRITE $SELECT($PIECE(NURSBAD,U,2)=1:"THE TOTAL FTEE",$PIECE(NURSBAD,U,2)=2:"TWO PRIMARY ASSIGNMENTS EXIST FOR",$PIECE(NURSBAD,U,2)=3:"THE START DATE IS GREATER THAN",$PIECE(NURSBAD,U,2)=4:"DUPLICATE SERVICE POSITIONS ON THE",1:"")
+8 IF $TEST
WRITE $SELECT($PIECE(NURSBAD,U,2)=7:"DUPLICATE DUTY TOURS ON THE",1:"")
+9 IF $TEST
WRITE $SELECT($PIECE(NURSBAD,U,2)=1:"",$PIECE(NURSBAD,U,2)=2:"",$PIECE(NURSBAD,U,2)=3:"",$PIECE(NURSBAD,U,2)=4:"",$PIECE(NURSBAD,U,2)=5:"NO PRIMARY POSITION WAS DESIGNATED, THIS POSITION WILL BE PRIMARY",$PIECE(NURSBAD,U,2)=7:"",1:"")
+10 IF $TEST
WRITE $SELECT($PIECE(NURSBAD,U,2)=1:"",$PIECE(NURSBAD,U,2)=2:"",$PIECE(NURSBAD,U,2)=3:"",$PIECE(NURSBAD,U,2)=4:"",$PIECE(NURSBAD,U,2)=5:"",$PIECE(NURSBAD,U,2)=6:"NO PRIMARY POSITION EXISTS FOR THIS ",...
... $PIECE(NURSBAD,U,2)=7:"",1:"INVALID DATA EXISTS FOR THIS")
+11 IF $TEST
WRITE !?5,$SELECT($PIECE(NURSBAD,U,2)=1:"WOULD BE GREATER THAN 1 FOR THIS ",$PIECE(NURSBAD,U,2)=2:"THIS ",$PIECE(NURSBAD,U,2)=3:"THE VACANCY DATE FOR THIS ",$PIECE(NURSBAD,U,2)=4!($PIECE(NURSBAD,U,2)=7):"SAME LOCATION EXIST FOR THIS ",1:"")
+12 IF $TEST
IF '($PIECE(NURSBAD,U,2)=5)
WRITE "EMPLOYEE. PLEASE RETRY THE CHANGE.",!
+13 KILL NURSBAD,NX
+14 QUIT
EN5 ; ENTRY FROM INPUT TRANSFORM FOR 2 & 3 SUBFIELDS OF FIELD 24
+1 ; OF FILE 210
+2 SET NURS(0)=$SELECT($DATA(^NURSF(210,DA(1),12,DA,0)):^(0),1:"")
SET NURS("HELP")="DATE MUST BE "_$PIECE("GREATER THAN DATE STARTED ^LESS THAN DATE ENDED ",U,NURS*10=20+1)
SET %DT(0)=+($EXTRACT("-",NURS*10=20)_$PIECE(NURS(0),U,$EXTRACT(23,NURS*10=20+1)))
+3 ;this check stops erroneous years from being entered if user responds with 010100 and FileMan returns 1/1/1900
IF %DT(0)=0
SET %DT(0)=2500101
+4 IF %DT(0)=0
KILL %DT(0)
SET %DT="E"
DO ^%DT
SET X=Y
IF Y<1
WRITE !?5,NURS("HELP")
KILL X
+5 KILL %DT,NURS
+6 QUIT
EN6(DA) ; SCREEN IF EMPLOYEE IS AUTHORIZED TO VIEW THIS LOCATION
+1 ; VARIABLES ARE SET BASED ON DIC("S") TO FILE 210.
+2 ;
+3 SET NURSZORT=1
+4 NEW NURNODE4,NUR200DA,NUR21182,NURDATA,NURSSEE
+5 SET NUR200DA=+$GET(^NURSF(210,+Y,0))
IF NUR200DA'>0
SET NURSZORT=0
+6 IF NURSZORT
Begin DoDot:1
+7 ; Check location security.
IF $GET(NURSZAP)>6
Begin DoDot:2
+8 SET NURSZORT=0
+9 SET NURNODE4=0
FOR
SET NURNODE4=$ORDER(^NURSF(211.8,"C",NUR200DA,NURNODE4))
IF NURNODE4'>0
QUIT
Begin DoDot:3
+10 SET NUR21182=0
FOR
SET NUR21182=$ORDER(^NURSF(211.8,"C",NUR200DA,NURNODE4,NUR21182))
IF NUR21182'>0
QUIT
Begin DoDot:4
+11 SET NURDATA=$GET(^NURSF(211.8,NURNODE4,1,NUR21182,0))
IF NURDATA=""
QUIT
+12 IF $PIECE(NURDATA,U)=""!($PIECE(NURDATA,U)>DT)!($PIECE(NURDATA,U,6)'=""&($PIECE(NURDATA,U,6)'>DT))
QUIT
+13 SET NURSZORT=1
DO EN3^NURSAUTL
+14 QUIT
End DoDot:4
IF NURSZORT
QUIT
+15 QUIT
End DoDot:3
IF NURSZORT
QUIT
+16 QUIT
End DoDot:2
IF 'NURSZORT
QUIT
+17 ; Check service position security.
IF $GET(NURSZAP)
DO EN2^NURSAUTL
+18 QUIT
End DoDot:1
+19 QUIT +$GET(NURSZORT)
+20 ;
EN7(DUZ) ; PRSE TRAIN SECURITY KEY CHECK
+1 QUIT $SELECT($DATA(^XUSEC("PRSE TRAIN",DUZ)):1,1:0)
EN8(DUZ) ; PRSE SUP SECURITY KEY CHECK
+1 QUIT $SELECT($DATA(^XUSEC("PRSE SUP",DUZ)):1,1:0)
EN9(DUZ) ; PRSE CORD SECURITY KEY CHECK
+1 QUIT $SELECT($DATA(^XUSEC("PRSE CORD",DUZ)):1,1:0)
EN10(DUZ) ;
+1 IF NURSZAP>0
IF +$$EN8^NURSUT3($GET(DUZ))
SET NURSZAP=0
QUIT
+2 IF NURSZAP>0
IF +$$EN9^NURSUT3($GET(DUZ))
SET NURSZAP=0
QUIT
+3 IF NURSZAP>7
IF +$$EN7^NURSUT3($GET(DUZ))
SET NURSZAP=7
+4 QUIT
EN11(DA) ; GET FACILITY WITH POSITION CONTROL IEN IN THE NURS POSITION
+1 ; CONTROL 211.8 FILE. THE VALUE OF THE FUNCTION WILL BE "" IF THERE
+2 ; IS NO FACILITY ASSOCIATED WITH THIS HOSPITAL LOCATION, OR THE
+3 ; FREE TEXT VALUE OF THE FACILITY
+4 SET XXX=""
SET DIC44DA=+$$GET1^DIQ(211.8,DA,.01,"I")
+5 IF DIC44DA
SET DIC4DA=+$$GET1^DIQ(44,DIC44DA,3,"I")
IF DIC4DA
SET XXX=$$GET1^DIQ(4,+DIC4DA,.01,"I")
+6 IF XXX=""
SET XXX=$SELECT($GET(NURMDSW):" BLANK",$GET(^NURSA(213.2,1,0)):$$GET1^DIQ(4,+$GET(^NURSA(213.2,1,0)),.01,"I"),1:"")
+7 KILL DIC44DA,DIC4DA
+8 QUIT XXX
EN12(DA) ; GET FACILITY WITH IEN FROM THE NURS LOCATION 211.4 FILE
+1 ; THE VALUE OF THE FUNCTION WILL BE " BLANK" IF THERE IS NO FACILITY ASSOCIATED
+2 ; WITH THIS NURS LOCATION OR THE FREE TEXT VALUE OF THE FACILITY
+3 SET XXX=""
SET DIC4DA=+$PIECE($GET(^SC(+$GET(^NURSF(211.4,+DA,0)),0)),U,4)
SET XXX=$$GET1^DIQ(4,+DIC4DA,.01,"I")
IF XXX=""
SET XXX=" BLANK"
KILL DIC4DA
+4 QUIT XXX
EN13(NOD1) ; GET PRODUCT LINE OF PRIMARY NURS LOCATIO WITH IEN FROM THE
+1 ; POSITION CONTROL FILE THE VALUE OF THE FUNCTION WILL BE " BLANK
+2 ; IF THERE IS NO PRODUCT LINE ASSOCIATED WITH THIS NURS LOCATION OR THE
+3 ; FREE TEXT VALUE OF THE PRODUCT LINE
+4 NEW NURUNIT,SC44DA,NUR2127
SET SC44DA=+$GET(^NURSF(211.8,NOD1,0))
SET NURUNIT=$ORDER(^NURSF(211.4,"B",SC44DA,0))
+5 SET XXX=" BLANK"
SET NUR2127=+$PIECE($GET(^NURSF(211.4,+NURUNIT,1)),U,4)
IF NUR2127
SET XXX=$$GET1^DIQ(212.7,+NUR2127,.01,"I")
+6 QUIT XXX
GETSER() ; THIS PROCEDURE WILL RETURN THE VALUE FOR NURSING IN THE
+1 ; PAID COST CENTER ORGANIZATION CODE (454.1) FILE. THE VALUE
+2 ; OF THE FUNCTION WILL BE "" IF THERE ARE NO NURSING ENTRIES, OR
+3 ; A LIST OF NURSING ENTRY IEN's SEPARATED BY ^'s.
+4 NEW FXN
+5 SET FXN(1)=$ORDER(^PRSP(454.1,"B","NURSING",0))
+6 SET FXN(2)=$ORDER(^PRSP(454.1,"B","NURSING SERVICE",0))
+7 IF FXN(1)!FXN(2)
SET FXN=U_$SELECT(FXN(1):FXN(1)_U,1:"")_$SELECT(FXN(2):FXN(2)_U,1:"")
+8 IF '$TEST
SET FXN=""
+9 QUIT FXN
