- NURSCEP ;HIRMFO/JH/MH/MD-LIST STAFF (#210) FILE DISCREPANCIES ;7/15/97
- ;;4.0;NURSING SERVICE;**6**;Apr 25, 1997
- TXT ;;This option generates an exception report that identifies the
- ;;following discrepancies between the NURS Staff (#210) and the
- ;;NURS Position Control (#211.8) Files:
- ;;
- ;;a. Staff record has no corresponding New Person (#200) file entry.
- ;;b. Staff record contains missing/invalid data in the Name field .01.
- ;;c. Staff record has missing/invalid Status data in field 5.5.
- ;;d. Staff record missing the 'B' index entry.
- ;;e. Staff Employee has 'ACTIVE' status and no active file 211.8 assignment(s).
- ;;f. Staff Record has 'B' index entry and no data on zeroth node.
- ;;g. File (#211.8) contains duplicate assignment entries for an employee.
- ;;h. File (#211.8) contains assignments with no corresponding staff record.
- ;;i. File (#211.8) contains active assignments for inactive nursing locations.
- ;;
- EN1 I '$D(^NURSF(210,0))!('$D(^NURSF(211.8,0))) W !!,"*** MISSING NURSING FILE ***" Q
- S TXT=$T(TXT) W ! F I=0:1:12 S TXT=$T(TXT+I) W !,$P(TXT,";",3)
- ASK W !!,"Do you want the discrepancy report queued to a printer ?" S DIR(0)="Y",DIR("B")="NO" D ^DIR S NUROUT=+$G(DIRUT) G QUIT:NUROUT G START:Y=0
- W ! S ZTDESC="STAFF DISCREPANCIES",ZTRTN="START^NURSCEP" D QUEUE G:$D(ZTSK)!$G(POP) QUIT D:$D(ZTSK)#2 HOME^%ZIS
- START U IO D NOW^%DTC S NDATE=%I(1)_"/"_%I(2)_"/"_$E(%I(3),2,3),(NSW1,NURQUEUE,NURPAGE,NURQUIT,NUROUT)=0 W ! K ^TMP("NOSTAFF",$J),^TMP("NURS",$J),^TMP("NURP",$J),^TMP("NURPOS",$J)
- I $E(IOST)="C" W !,"Checking the NURS Staff (#210) File..."
- S (NUM,NURSDA)=0 F S NURSDA=$O(^NURSF(210,NURSDA)) Q:NURSDA'>0 S NPDA=+$G(^NURSF(210,NURSDA,0)),NSTAT=$P($G(^(0)),U,2),NAM=$S($G(^VA(200,+NPDA,0))'="":$P(^(0),U),1:"** INVALID NAME DATA **"),NUM=(NUM+1) D
- . W:$E(IOST)="C"&($R(2000)) "." I '$$EN1^NURSUT0(NPDA,DT),$P($G(^NURSF(210,NURSDA,0)),U,2)="A",$D(^VA(200,NPDA,0)) S SW=5 D SETSTF ;Active employee/no assignment(s)
- . I $P($G(^NURSF(210,NURSDA,0)),U)'>0 S SW=2 D SETSTF ;Emp. entry has missing/invalid data in name field
- . I '$D(^VA(200,NPDA,0)),'$D(^TMP("NURS",$J,NUM,3,NURSDA)) S SW=1 D SETSTF ;Employee not in New Person File.
- . I '$D(^NURSF(210,"B",NPDA)),'$D(^TMP("NURS",$J,NUM,3,NURSDA)) S SW=4 D SETSTF ;Emp. has missing B xrf in Nurstaff File.
- . I NSTAT'="A",NSTAT'="R",NSTAT'="I"!(NSTAT="") S SW=3 D SETSTF
- . Q
- S NPDA=0 F S NPDA=$O(^NURSF(210,"B",NPDA)) Q:NPDA'>0 S NURSDA=$O(^NURSF(210,"B",NPDA,0)) I +NURSDA,$G(^NURSF(210,+NURSDA,0))="" D
- . S NUM=(NUM+1),NAM=$S($G(^VA(200,+NPDA,0))'="":$P(^(0),U),1:"** INVALID NAME DATA **"),SW=6 D SETSTF ; 'B' xref no data on zeroth node
- . Q
- I $E(IOST)="C" W !,"Checking the NURS Position Control (#211.8) File..."
- S NOD=0 F S NOD=$O(^NURSF(211.8,NOD)) Q:NOD'>0 S NDA=0 F S NDA=$O(^NURSF(211.8,NOD,1,NDA)) Q:NDA'>0 I $G(^NURSF(211.8,NOD,1,NDA,0))'="",$P($G(^(0)),U,6)="" D
- . S NAM=+$P(^NURSF(211.8,NOD,1,NDA,0),U,2),NFTE=+$P($G(^(0)),U,4)
- . S Q=$G(^NURSF(211.8,NOD,1,NDA,0)) S STDAT=$P(Q,U),NPOS=$P(Q,U,3),NFT=$P(Q,U,4),ENDAT=$P(Q,U,6)
- . S NPOS(1)=$S($D(^NURSF(211.3,+NPOS,0)):$P(^(0),U,1),1:""),NSWRD=$P($G(^NURSF(211.8,NOD,0)),U),NWRD=$P($P(^SC(NSWRD,0),"NUR ",2),U)
- . S:STDAT'="" SDAT=$E(STDAT,4,5)_"/"_$E(STDAT,6,7)_"/"_$E(STDAT,2,3) S EDAT="" S:ENDAT'="" EDAT=$E(ENDAT,4,5)_"/"_$E(ENDAT,6,7)_"/"_$E(ENDAT,2,3)
- . I $$STAT^NURSCEP1(NOD) S ^TMP("INACT",$J,NAM,NOD,NDA)=NPOS(1)_U_NWRD_U_NFT_U_SDAT_U_EDAT
- . S:'$D(^NURSF(210,"B",NAM)) ^TMP("NOSTAFF",$J,NAM,NOD,NDA)=NPOS(1)_U_NWRD_U_NFT_U_SDAT_U_EDAT
- . I NFTE>0,$D(^TMP("NURPOS",$J,NAM,1)) S ^TMP("NURPOS",$J,NAM,1)=^TMP("NURPOS",$J,NAM,1)_NOD_";"_NDA_U F X=1:1 Q:$P(^TMP("NURPOS",$J,NAM,1),U,X)="" S Y=$P(^(1),U,X),NOD=$P(Y,";"),NDA=$P(Y,";",2) D GETDATA
- . S:'$D(^TMP("NURPOS",$J,NAM,NFTE)) ^(NFTE)=NOD_";"_NDA_U
- . Q
- I '$D(^TMP("NURS",$J)),'$D(^TMP("NURP",$J)),'$D(^TMP("NOSTAFF",$J)),'$D(^TMP("INACT",$J)) S NURTYPE="" D HDR^NURSCEP1 W !!,"No discrepancies were found between the 210 and 211.8 files." G QUIT
- D ^NURSCEP1
- QUIT ;
- Q K ^TMP("NOSTAFF",$J),^TMP("NURS",$J),^TMP("NURP",$J),^TMP("NURPOS",$J) D CLOSE^NURSUT1,^NURSKILL
- Q
- QUEUE ;
- S %ZIS="Q",IOP="Q" D ^%ZIS K %ZIS K:POP IO("Q") Q:POP
- I $D(IO("Q")) K IO("Q"),IO("C") S ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL D ^%ZTLOAD S:'$D(ZTSK) POP=1
- Q
- GETDATA ;
- W:$E(IOST)="C"&($R(20000)) "."
- S:'$D(^TMP("NURP",$J,NAM,NOD,NDA)) ^(NDA)=NPOS(1)_U_NWRD_U_NFT_U_SDAT_U_EDAT
- Q
- SETSTF ;
- S:'$D(^TMP("NURS",$J,"L",NURSDA,NAM)) ^(NAM)=NUM
- S ^TMP("NURS",$J,"L1",NUM,SW)=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSCEP 4565 printed Feb 18, 2025@23:48:08 Page 2
- NURSCEP ;HIRMFO/JH/MH/MD-LIST STAFF (#210) FILE DISCREPANCIES ;7/15/97
- +1 ;;4.0;NURSING SERVICE;**6**;Apr 25, 1997
- TXT ;;This option generates an exception report that identifies the
- +1 ;;following discrepancies between the NURS Staff (#210) and the
- +2 ;;NURS Position Control (#211.8) Files:
- +3 ;;
- +4 ;;a. Staff record has no corresponding New Person (#200) file entry.
- +5 ;;b. Staff record contains missing/invalid data in the Name field .01.
- +6 ;;c. Staff record has missing/invalid Status data in field 5.5.
- +7 ;;d. Staff record missing the 'B' index entry.
- +8 ;;e. Staff Employee has 'ACTIVE' status and no active file 211.8 assignment(s).
- +9 ;;f. Staff Record has 'B' index entry and no data on zeroth node.
- +10 ;;g. File (#211.8) contains duplicate assignment entries for an employee.
- +11 ;;h. File (#211.8) contains assignments with no corresponding staff record.
- +12 ;;i. File (#211.8) contains active assignments for inactive nursing locations.
- +13 ;;
- EN1 IF '$DATA(^NURSF(210,0))!('$DATA(^NURSF(211.8,0)))
- WRITE !!,"*** MISSING NURSING FILE ***"
- QUIT
- +1 SET TXT=$TEXT(TXT)
- WRITE !
- FOR I=0:1:12
- SET TXT=$TEXT(TXT+I)
- WRITE !,$PIECE(TXT,";",3)
- ASK WRITE !!,"Do you want the discrepancy report queued to a printer ?"
- SET DIR(0)="Y"
- SET DIR("B")="NO"
- DO ^DIR
- SET NUROUT=+$GET(DIRUT)
- if NUROUT
- GOTO QUIT
- if Y=0
- GOTO START
- +1 WRITE !
- SET ZTDESC="STAFF DISCREPANCIES"
- SET ZTRTN="START^NURSCEP"
- DO QUEUE
- if $DATA(ZTSK)!$GET(POP)
- GOTO QUIT
- if $DATA(ZTSK)#2
- DO HOME^%ZIS
- START USE IO
- DO NOW^%DTC
- SET NDATE=%I(1)_"/"_%I(2)_"/"_$EXTRACT(%I(3),2,3)
- SET (NSW1,NURQUEUE,NURPAGE,NURQUIT,NUROUT)=0
- WRITE !
- KILL ^TMP("NOSTAFF",$JOB),^TMP("NURS",$JOB),^TMP("NURP",$JOB),^TMP("NURPOS",$JOB)
- +1 IF $EXTRACT(IOST)="C"
- WRITE !,"Checking the NURS Staff (#210) File..."
- +2 SET (NUM,NURSDA)=0
- FOR
- SET NURSDA=$ORDER(^NURSF(210,NURSDA))
- if NURSDA'>0
- QUIT
- SET NPDA=+$GET(^NURSF(210,NURSDA,0))
- SET NSTAT=$PIECE($GET(^(0)),U,2)
- SET NAM=$SELECT($GET(^VA(200,+NPDA,0))'="":$PIECE(^(0),U),1:"** INVALID NAME DATA **")
- SET NUM=(NUM+1)
- Begin DoDot:1
- +3 ;Active employee/no assignment(s)
- if $EXTRACT(IOST)="C"&($RANDOM(2000))
- WRITE "."
- IF '$$EN1^NURSUT0(NPDA,DT)
- IF $PIECE($GET(^NURSF(210,NURSDA,0)),U,2)="A"
- IF $DATA(^VA(200,NPDA,0))
- SET SW=5
- DO SETSTF
- +4 ;Emp. entry has missing/invalid data in name field
- IF $PIECE($GET(^NURSF(210,NURSDA,0)),U)'>0
- SET SW=2
- DO SETSTF
- +5 ;Employee not in New Person File.
- IF '$DATA(^VA(200,NPDA,0))
- IF '$DATA(^TMP("NURS",$JOB,NUM,3,NURSDA))
- SET SW=1
- DO SETSTF
- +6 ;Emp. has missing B xrf in Nurstaff File.
- IF '$DATA(^NURSF(210,"B",NPDA))
- IF '$DATA(^TMP("NURS",$JOB,NUM,3,NURSDA))
- SET SW=4
- DO SETSTF
- +7 IF NSTAT'="A"
- IF NSTAT'="R"
- IF NSTAT'="I"!(NSTAT="")
- SET SW=3
- DO SETSTF
- +8 QUIT
- End DoDot:1
- +9 SET NPDA=0
- FOR
- SET NPDA=$ORDER(^NURSF(210,"B",NPDA))
- if NPDA'>0
- QUIT
- SET NURSDA=$ORDER(^NURSF(210,"B",NPDA,0))
- IF +NURSDA
- IF $GET(^NURSF(210,+NURSDA,0))=""
- Begin DoDot:1
- +10 ; 'B' xref no data on zeroth node
- SET NUM=(NUM+1)
- SET NAM=$SELECT($GET(^VA(200,+NPDA,0))'="":$PIECE(^(0),U),1:"** INVALID NAME DATA **")
- SET SW=6
- DO SETSTF
- +11 QUIT
- End DoDot:1
- +12 IF $EXTRACT(IOST)="C"
- WRITE !,"Checking the NURS Position Control (#211.8) File..."
- +13 SET NOD=0
- FOR
- SET NOD=$ORDER(^NURSF(211.8,NOD))
- if NOD'>0
- QUIT
- SET NDA=0
- FOR
- SET NDA=$ORDER(^NURSF(211.8,NOD,1,NDA))
- if NDA'>0
- QUIT
- IF $GET(^NURSF(211.8,NOD,1,NDA,0))'=""
- IF $PIECE($GET(^(0)),U,6)=""
- Begin DoDot:1
- +14 SET NAM=+$PIECE(^NURSF(211.8,NOD,1,NDA,0),U,2)
- SET NFTE=+$PIECE($GET(^(0)),U,4)
- +15 SET Q=$GET(^NURSF(211.8,NOD,1,NDA,0))
- SET STDAT=$PIECE(Q,U)
- SET NPOS=$PIECE(Q,U,3)
- SET NFT=$PIECE(Q,U,4)
- SET ENDAT=$PIECE(Q,U,6)
- +16 SET NPOS(1)=$SELECT($DATA(^NURSF(211.3,+NPOS,0)):$PIECE(^(0),U,1),1:"")
- SET NSWRD=$PIECE($GET(^NURSF(211.8,NOD,0)),U)
- SET NWRD=$PIECE($PIECE(^SC(NSWRD,0),"NUR ",2),U)
- +17 if STDAT'=""
- SET SDAT=$EXTRACT(STDAT,4,5)_"/"_$EXTRACT(STDAT,6,7)_"/"_$EXTRACT(STDAT,2,3)
- SET EDAT=""
- if ENDAT'=""
- SET EDAT=$EXTRACT(ENDAT,4,5)_"/"_$EXTRACT(ENDAT,6,7)_"/"_$EXTRACT(ENDAT,2,3)
- +18 IF $$STAT^NURSCEP1(NOD)
- SET ^TMP("INACT",$JOB,NAM,NOD,NDA)=NPOS(1)_U_NWRD_U_NFT_U_SDAT_U_EDAT
- +19 if '$DATA(^NURSF(210,"B",NAM))
- SET ^TMP("NOSTAFF",$JOB,NAM,NOD,NDA)=NPOS(1)_U_NWRD_U_NFT_U_SDAT_U_EDAT
- +20 IF NFTE>0
- IF $DATA(^TMP("NURPOS",$JOB,NAM,1))
- SET ^TMP("NURPOS",$JOB,NAM,1)=^TMP("NURPOS",$JOB,NAM,1)_NOD_";"_NDA_U
- FOR X=1:1
- if $PIECE(^TMP("NURPOS",$JOB,NAM,1),U,X)=""
- QUIT
- SET Y=$PIECE(^(1),U,X)
- SET NOD=$PIECE(Y,";")
- SET NDA=$PIECE(Y,";",2)
- DO GETDATA
- +21 if '$DATA(^TMP("NURPOS",$JOB,NAM,NFTE))
- SET ^(NFTE)=NOD_";"_NDA_U
- +22 QUIT
- End DoDot:1
- +23 IF '$DATA(^TMP("NURS",$JOB))
- IF '$DATA(^TMP("NURP",$JOB))
- IF '$DATA(^TMP("NOSTAFF",$JOB))
- IF '$DATA(^TMP("INACT",$JOB))
- SET NURTYPE=""
- DO HDR^NURSCEP1
- WRITE !!,"No discrepancies were found between the 210 and 211.8 files."
- GOTO QUIT
- +24 DO ^NURSCEP1
- QUIT ;
- Q KILL ^TMP("NOSTAFF",$JOB),^TMP("NURS",$JOB),^TMP("NURP",$JOB),^TMP("NURPOS",$JOB)
- DO CLOSE^NURSUT1
- DO ^NURSKILL
- +1 QUIT
- QUEUE ;
- +1 SET %ZIS="Q"
- SET IOP="Q"
- DO ^%ZIS
- KILL %ZIS
- if POP
- KILL IO("Q")
- if POP
- QUIT
- +2 IF $DATA(IO("Q"))
- KILL IO("Q"),IO("C")
- SET ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
- DO ^%ZTLOAD
- if '$DATA(ZTSK)
- SET POP=1
- +3 QUIT
- GETDATA ;
- +1 if $EXTRACT(IOST)="C"&($RANDOM(20000))
- WRITE "."
- +2 if '$DATA(^TMP("NURP",$JOB,NAM,NOD,NDA))
- SET ^(NDA)=NPOS(1)_U_NWRD_U_NFT_U_SDAT_U_EDAT
- +3 QUIT
- SETSTF ;
- +1 if '$DATA(^TMP("NURS",$JOB,"L",NURSDA,NAM))
- SET ^(NAM)=NUM
- +2 SET ^TMP("NURS",$JOB,"L1",NUM,SW)=""
- +3 QUIT