- NURAED2 ;HIRMFO/MD,RM,FT-EDIT FOR POSITION ;5/14/01 15:37
- ;;4.0;NURSING SERVICE;**1,33,35**;Apr 25, 1997
- VALSEL ; VALIDATE SELECTIONS
- F NUR1=1:1 S NUR2=$P(NURAES,",",NUR1) Q:NUR2="" S:NUR2="n" NUR2="N" D VAL0 Q:$G(NURSBAD)
- Q
- VAL0 ;VALIDATION CONTINUED
- I NUR2="N" S NURSUL("N")="" Q
- I +NUR2>NCNT!(+NUR2<1) S NURSBAD=1 Q
- I NUR2["-",$P(NUR2,"-")'?1.N!($P(NUR2,"-",2)'?1.N0.1"@")!(+$P(NUR2,"-",2)>NCNT)!(+$P(NUR2,"-",2)<1)!(+NUR2>NCNT)!(+NUR2<1) S NURSBAD=1 Q
- I NUR2'["-",NUR2'?1.N0.1"@"!(+NUR2>NCNT)!(+NUR2<1) S NURSBAD=1 Q
- S NUR3=$S(NUR2["-":+$P(NUR2,"-",2),1:+NUR2)
- F NUR10=+NUR2:1:NUR3 S NURSUL(NUR10)=$P(NUR2,NUR3,2)
- Q
- VALENT ; VALIDATE THE DATA ENTRY FOR THIS EMPLOYEE BY CALLING EN4^NURSUT2.
- N DA
- S NUR=$O(NUR("SDT","")),DA(1)=$O(NUR("SDT",+NUR,"")),DA=$O(NUR("SDT",+NUR,+DA(1),"")) Q:DA(1)'>0!(DA'>0)
- S NUR(0)=NUR("SDT",+NUR,DA(1),DA) I NUR(0)="" K NUR Q
- D EN4^NURSUT2 S:$G(NURSBAD)&'($P(NURSBAD,U,2)=5) NUROUT=1 W:$G(NURSBAD) !! D EN4^NURSUT3
- Q
- VALE0 ; BUILD UP LOCAL NUR ARRAY TO USE IN TMP EN4^NURSUT2 TO
- ; VALIDATE THE ENTRY OF THESE POSITIONS.
- N DA S NUR(1)=$S($P(NURSASS(NURSANM),"^"):$P(NURSASS(NURSANM),"^"),1:9999999-NURSANM),NUR(2)=$S($P(NURSASS(NURSANM),"^",2):$P(NURSASS(NURSANM),"^",2),1:9999999-NURSANM),(DA(1),DA)=0
- S NUR(3)=$S('$D(NURSPOS(NURSANM)):$P(NURSASS(NURSANM),"^",3,14),1:NURSPOS(NURSANM)) I NUR(3)'="" D
- .I $G(NURSPOS(NURSANM))=NUR(3),'(NURSASS(NURSANM)="") D
- ..S NUR(2)=9999999
- ..S NUR(1)=$O(^NURSF(211.8,"AA",+NURSPOS(NURSANM),$P(NURSPOS(NURSANM),U,2),""))
- ..I +NUR(1)'>0 S NUR(1)=$$NEW2118(+NURSPOS(NURSANM),$P(NURSPOS(NURSANM),U,2),$P(NURSPOS(NURSANM),U,5))
- ..Q
- . S NUR(3)=$P(NUR(3),"^",3,99) D ST1^NURSUT2
- . Q
- I $D(NURSPOS(NURSANM)),NURSASS(NURSANM)="" D
- . N % S %=NUR("SDT",$P(NUR(3),U),NUR(1),NUR(2))
- . S NUR("SDT",$P(NUR(3),U),NUR(1),NUR(2))=$P(NURSPOS(NURSANM),"^",1,2)_%
- . S %=NUR("VDT",$S($P(NUR(3),U,6):$P(NUR(3),U,6),1:9999999),NUR(1),NUR(2))
- . S NUR("VDT",$S($P(NUR(3),U,6):$P(NUR(3),U,6),1:9999999),NUR(1),NUR(2))=$P(NURSPOS(NURSANM),"^",1,2)_%
- . Q
- Q
- EN1 ; USING NURSUL(#) DETERMINE IF EDIT, ADD, DELETE AND SET NURSPOS(#)
- K NURSPOS S NURSUL="" F NURSX=0:0 S NURSUL=$O(NURSUL(NURSUL)) Q:NURSUL="" D PROC Q:$G(NUROUT)
- Q
- PROC ; PROCESS THE NURSUL(#) SELECTION
- I NURSUL="N"&(NURLS="P") D MSG^NURAED1 S MSG=1 Q
- I NURSUL(NURSUL)="@" S NURSPOS(NURSUL)="" Q
- I NURSUL(NURSUL)="",NURSUL'="N" W !!,"EDITING POSITION ",NURSUL,! S NURSOPOS=$P(NURSASS(NURSUL),"^",3,14) D EDTFLD^NURAED5 Q:$G(NUROUT) S:NURSNPOS'=$P(NURSASS(NURSUL),"^",3,14) NURSPOS(NURSUL)=NURSNPOS Q
- I NURSUL="N" S NURSW1=0 D ADAS
- Q
- ADAS ; ADD NEW ASSIGNMENTS
- W !,$C(7),"Would you like to add a new assignment" S %=$S(NURSW1:2,1:1) D YN^DICN S:%=-1 NUROUT=1 Q:$G(NUROUT)!(%=2&'$O(NURSL(0))&($D(NURSNPOS))!(%=2&'$O(NURSL(0))))
- I '% W !?5,$C(7),"ANSWER YES IF YOU WISH TO ADD A NEW ASSIGNMENT, ELSE ANSWER NO." G ADAS
- S NURSW1=1,NCNT=NCNT+1,(NURSASS(NCNT),NURSOPOS)="",$P(NURSOPOS,"^",4)=NID D EDTFLD^NURAED5 I $G(NUROUT) S NCNT=NCNT-1 Q
- S NURSPOS(NCNT)=NURSNPOS
- G ADAS
- NEW2118(NURNLOC,NURNCAT,NURNPOS) ; Function that adds a new entry to the
- ; NURS POSITION CONTROL (#211.8) file.
- ; NURNLOC - the .01 value of the entry (i.e., FILE 44 pointer value)
- ; NURNCAT - the service category code (e.g., "R" for registered nurse)
- ; NURNPOS - the ien of the Service Position (File 211.3)
- ; Returns the IEN of the new entry in File 211.8
- N DA,DIC,DIE,DR,NUR,NURARRAY,NURNY,NURSHLIT,X,Y
- S DIC="^NURSF(211.8,",DIC(0)="LZ",X=NURNLOC
- S DIC("DR")=".02///"_NURNCAT
- K DD,DO
- D FILE^DICN
- I Y'>0 Q 0
- S (DA(1),NURNY)=+Y
- S ^NURSF(211.8,NURNY,1,0)="^211.82ID^^" ;occupancy/transferred date
- S:$G(^NURSF(211.8,NURNY,2,0))="" ^(0)="^211.83P^^" ;position budgeted
- S DIC="^NURSF(211.8,NURNY,2,",DIC(0)="L",X=+NURNPOS
- S DIC("DR")=".05///^S X=$$NPRI^NURSBPO(NURNPOS)"
- K DD,DO
- D FILE^DICN
- S NURARRAY(1)=" "
- S NURARRAY(2)="Please use the 'Nursing Location File, Edit' option to add BUDGETED FTEE for"
- S NURARRAY(3)="this SERVICE POSITION."
- S NURARRAY(4)=" "
- D EN^DDIOL(.NURARRAY)
- H 3
- Q NURNY
- NURAED2 ;HIRMFO/MD,RM,FT-EDIT FOR POSITION ;5/14/01 15:37
- +1 ;;4.0;NURSING SERVICE;**1,33,35**;Apr 25, 1997
- VALSEL ; VALIDATE SELECTIONS
- +1 FOR NUR1=1:1
- SET NUR2=$PIECE(NURAES,",",NUR1)
- IF NUR2=""
- QUIT
- IF NUR2="n"
- SET NUR2="N"
- DO VAL0
- IF $GET(NURSBAD)
- QUIT
- +2 QUIT
- VAL0 ;VALIDATION CONTINUED
- +1 IF NUR2="N"
- SET NURSUL("N")=""
- QUIT
- +2 IF +NUR2>NCNT!(+NUR2<1)
- SET NURSBAD=1
- QUIT
- +3 IF NUR2["-"
- IF $PIECE(NUR2,"-")'?1.N!($PIECE(NUR2,"-",2)'?1.N0.1"@")!(+$PIECE(NUR2,"-",2)>NCNT)!(+$PIECE(NUR2,"-",2)<1)!(+NUR2>NCNT)!(+NUR2<1)
- SET NURSBAD=1
- QUIT
- +4 IF NUR2'["-"
- IF NUR2'?1.N0.1"@"!(+NUR2>NCNT)!(+NUR2<1)
- SET NURSBAD=1
- QUIT
- +5 SET NUR3=$SELECT(NUR2["-":+$PIECE(NUR2,"-",2),1:+NUR2)
- +6 FOR NUR10=+NUR2:1:NUR3
- SET NURSUL(NUR10)=$PIECE(NUR2,NUR3,2)
- +7 QUIT
- VALENT ; VALIDATE THE DATA ENTRY FOR THIS EMPLOYEE BY CALLING EN4^NURSUT2.
- +1 NEW DA
- +2 SET NUR=$ORDER(NUR("SDT",""))
- SET DA(1)=$ORDER(NUR("SDT",+NUR,""))
- SET DA=$ORDER(NUR("SDT",+NUR,+DA(1),""))
- IF DA(1)'>0!(DA'>0)
- QUIT
- +3 SET NUR(0)=NUR("SDT",+NUR,DA(1),DA)
- IF NUR(0)=""
- KILL NUR
- QUIT
- +4 DO EN4^NURSUT2
- IF $GET(NURSBAD)&'($PIECE(NURSBAD,U,2)=5)
- SET NUROUT=1
- IF $GET(NURSBAD)
- WRITE !!
- DO EN4^NURSUT3
- +5 QUIT
- VALE0 ; BUILD UP LOCAL NUR ARRAY TO USE IN TMP EN4^NURSUT2 TO
- +1 ; VALIDATE THE ENTRY OF THESE POSITIONS.
- +2 NEW DA
- SET NUR(1)=$SELECT($PIECE(NURSASS(NURSANM),"^"):$PIECE(NURSASS(NURSANM),"^"),1:9999999-NURSANM)
- SET NUR(2)=$SELECT($PIECE(NURSASS(NURSANM),"^",2):$PIECE(NURSASS(NURSANM),"^",2),1:9999999-NURSANM)
- SET (DA(1),DA)=0
- +3 SET NUR(3)=$SELECT('$DATA(NURSPOS(NURSANM)):$PIECE(NURSASS(NURSANM),"^",3,14),1:NURSPOS(NURSANM))
- IF NUR(3)'=""
- Begin DoDot:1
- +4 IF $GET(NURSPOS(NURSANM))=NUR(3)
- IF '(NURSASS(NURSANM)="")
- Begin DoDot:2
- +5 SET NUR(2)=9999999
- +6 SET NUR(1)=$ORDER(^NURSF(211.8,"AA",+NURSPOS(NURSANM),$PIECE(NURSPOS(NURSANM),U,2),""))
- +7 IF +NUR(1)'>0
- SET NUR(1)=$$NEW2118(+NURSPOS(NURSANM),$PIECE(NURSPOS(NURSANM),U,2),$PIECE(NURSPOS(NURSANM),U,5))
- +8 QUIT
- End DoDot:2
- +9 SET NUR(3)=$PIECE(NUR(3),"^",3,99)
- DO ST1^NURSUT2
- +10 QUIT
- End DoDot:1
- +11 IF $DATA(NURSPOS(NURSANM))
- IF NURSASS(NURSANM)=""
- Begin DoDot:1
- +12 NEW %
- SET %=NUR("SDT",$PIECE(NUR(3),U),NUR(1),NUR(2))
- +13 SET NUR("SDT",$PIECE(NUR(3),U),NUR(1),NUR(2))=$PIECE(NURSPOS(NURSANM),"^",1,2)_%
- +14 SET %=NUR("VDT",$SELECT($PIECE(NUR(3),U,6):$PIECE(NUR(3),U,6),1:9999999),NUR(1),NUR(2))
- +15 SET NUR("VDT",$SELECT($PIECE(NUR(3),U,6):$PIECE(NUR(3),U,6),1:9999999),NUR(1),NUR(2))=$PIECE(NURSPOS(NURSANM),"^",1,2)_%
- +16 QUIT
- End DoDot:1
- +17 QUIT
- EN1 ; USING NURSUL(#) DETERMINE IF EDIT, ADD, DELETE AND SET NURSPOS(#)
- +1 KILL NURSPOS
- SET NURSUL=""
- FOR NURSX=0:0
- SET NURSUL=$ORDER(NURSUL(NURSUL))
- IF NURSUL=""
- QUIT
- DO PROC
- IF $GET(NUROUT)
- QUIT
- +2 QUIT
- PROC ; PROCESS THE NURSUL(#) SELECTION
- +1 IF NURSUL="N"&(NURLS="P")
- DO MSG^NURAED1
- SET MSG=1
- QUIT
- +2 IF NURSUL(NURSUL)="@"
- SET NURSPOS(NURSUL)=""
- QUIT
- +3 IF NURSUL(NURSUL)=""
- IF NURSUL'="N"
- WRITE !!,"EDITING POSITION ",NURSUL,!
- SET NURSOPOS=$PIECE(NURSASS(NURSUL),"^",3,14)
- DO EDTFLD^NURAED5
- IF $GET(NUROUT)
- QUIT
- IF NURSNPOS'=$PIECE(NURSASS(NURSUL),"^",3,14)
- SET NURSPOS(NURSUL)=NURSNPOS
- QUIT
- +4 IF NURSUL="N"
- SET NURSW1=0
- DO ADAS
- +5 QUIT
- ADAS ; ADD NEW ASSIGNMENTS
- +1 WRITE !,$CHAR(7),"Would you like to add a new assignment"
- SET %=$SELECT(NURSW1:2,1:1)
- DO YN^DICN
- IF %=-1
- SET NUROUT=1
- IF $GET(NUROUT)!(%=2&'$ORDER(NURSL(0))&($DATA(NURSNPOS))!(%=2&'$ORDER(NURSL(0))))
- QUIT
- +2 IF '%
- WRITE !?5,$CHAR(7),"ANSWER YES IF YOU WISH TO ADD A NEW ASSIGNMENT, ELSE ANSWER NO."
- GOTO ADAS
- +3 SET NURSW1=1
- SET NCNT=NCNT+1
- SET (NURSASS(NCNT),NURSOPOS)=""
- SET $PIECE(NURSOPOS,"^",4)=NID
- DO EDTFLD^NURAED5
- IF $GET(NUROUT)
- SET NCNT=NCNT-1
- QUIT
- +4 SET NURSPOS(NCNT)=NURSNPOS
- +5 GOTO ADAS
- NEW2118(NURNLOC,NURNCAT,NURNPOS) ; Function that adds a new entry to the
- +1 ; NURS POSITION CONTROL (#211.8) file.
- +2 ; NURNLOC - the .01 value of the entry (i.e., FILE 44 pointer value)
- +3 ; NURNCAT - the service category code (e.g., "R" for registered nurse)
- +4 ; NURNPOS - the ien of the Service Position (File 211.3)
- +5 ; Returns the IEN of the new entry in File 211.8
- +6 NEW DA,DIC,DIE,DR,NUR,NURARRAY,NURNY,NURSHLIT,X,Y
- +7 SET DIC="^NURSF(211.8,"
- SET DIC(0)="LZ"
- SET X=NURNLOC
- +8 SET DIC("DR")=".02///"_NURNCAT
- +9 KILL DD,DO
- +10 DO FILE^DICN
- +11 IF Y'>0
- QUIT 0
- +12 SET (DA(1),NURNY)=+Y
- +13 ;occupancy/transferred date
- SET ^NURSF(211.8,NURNY,1,0)="^211.82ID^^"
- +14 ;position budgeted
- IF $GET(^NURSF(211.8,NURNY,2,0))=""
- SET ^(0)="^211.83P^^"
- +15 SET DIC="^NURSF(211.8,NURNY,2,"
- SET DIC(0)="L"
- SET X=+NURNPOS
- +16 SET DIC("DR")=".05///^S X=$$NPRI^NURSBPO(NURNPOS)"
- +17 KILL DD,DO
- +18 DO FILE^DICN
- +19 SET NURARRAY(1)=" "
- +20 SET NURARRAY(2)="Please use the 'Nursing Location File, Edit' option to add BUDGETED FTEE for"
- +21 SET NURARRAY(3)="this SERVICE POSITION."
- +22 SET NURARRAY(4)=" "
- +23 DO EN^DDIOL(.NURARRAY)
- +24 HANG 3
- +25 QUIT NURNY
