- NURSXECP ;HIRMFO/MD-NURSING DATA EXCEPTION REPORT ;AUG 93
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- EN1 ; CHECK NURSING EDUCATION DATA
- S (NURQUIT,NURQUEUE,NUROUT)=0
- S ZTRTN="START^NURSXECP" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
- START ;
- K ^TMP($J) S (NURSW1,NURQUIT,NURPAGE)=0 F DA=0:0 S DA=$O(^NURSF(210,DA)) Q:DA'>0 I +$G(^NURSF(210,DA,0)) W:$R(100) "." D
- . S NAME=$S($P($G(^VA(200,+$G(^NURSF(210,DA,0)),0)),U)'="":$P($G(^VA(200,+$G(^NURSF(210,DA,0)),0)),U),1:+$G(^NURSF(210,DA,0)))
- . F D1=0:0 S D1=$O(^NURSF(210,DA,8,D1)) Q:D1'>0 I '($G(^NURSF(210,DA,8,D1,0))="") D
- . . S DATA=$G(^NURSF(210,DA,8,D1,0)),CLASS=$S($D(^NURSF(212.4,+$P(DATA,U,2),0)):$P($G(^NURSF(212.4,+$P(DATA,U,2),0)),U),'(+$P(DATA,U,2)>0):0,1:1),DATE=+DATA D CHKCLS
- . . Q
- . F D2=0:0 S D2=$O(^NURSF(210,DA,18,D2)) Q:D2'>0 I '($G(^NURSF(210,DA,18,D2,0))="") D
- . . S DATA=$G(^NURSF(210,DA,18,D2,0)),CLASS=$S($P($G(^NURSF(210,DA,18,D2,0)),U)'="":$P($G(^(0)),U),1:0),DATE=+$P($G(^(0)),U,2) D CHKCLS
- . . Q
- . Q
- I $O(^TMP("NURPRSE",$J,""))="" D HEADER W !,"THERE WERE NO EXCEPTION RECORDS FOUND!" G QUIT
- S NAME="" F S NAME=$O(^TMP("NURPRSE",$J,NAME)) Q:NAME="" S CLASS="" F S CLASS=$O(^TMP("NURPRSE",$J,NAME,CLASS)) Q:CLASS="" S DATE="" F S DATE=$O(^TMP("NURPRSE",$J,NAME,CLASS,DATE)) Q:DATE="" D
- . I 'NURSW1!($Y>(IOSL-2)) D HEADER Q:NURQUIT
- . W !,$S(CLASS=" BLANK":"",1:CLASS),?34,$S(DATE=" BLANK":"",1:$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)),?48,NAME,!,"DISCREPANCY: ",^TMP("NURPRSE",$J,NAME,CLASS,DATE),!!
- . Q
- QUIT ;
- Q K ^TMP("NURPRSE",$J) D CLOSE^NURSUT1,^NURSKILL
- Q
- CHKCLS I CLASS=0,+DATE S ^TMP("NURPRSE",$J,NAME," BLANK",DATE)="MISSING CLASS NAME"
- I CLASS=1,+DATE S ^TMP("NURPRSE",$J,NAME," BLANK",DATE)="POINTED TO CLASS IS MISSING" Q
- I '(+DATE>0) S ^TMP("NURPRSE",$J,NAME,CLASS," BLANK")="MISSING CLASS DATE" Q
- I +NAME S ^TMP("NURPRSE",$J,NAME,CLASS,DATE)="BAD NEW PERSON FILE POINTER"
- I $D(^TMP($J,NAME,CLASS,DATE)) S ^TMP("NURPRSE",$J,NAME,CLASS,DATE)="PREVIOUS ENTRY FOR THIS RECORD/EMPLOYEE"
- S ^TMP($J,NAME,CLASS,DATE)=""
- Q
- S X="T",NURPAGE=NURPAGE+1,NURSW1=1 D ^%DT D:+Y D^DIQ W @IOF,Y,?25,"NURSING EDUCATION DATA EXCEPTION REPORT",?72,"PAGE: ",NURPAGE
- W !!,"CLASS",?35,"DATE",?48,"EMPLOYEE NAME"
- S X="",$P(X,"-",80)="" W !,X
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSXECP 2422 printed Feb 18, 2025@23:48:53 Page 2
- NURSXECP ;HIRMFO/MD-NURSING DATA EXCEPTION REPORT ;AUG 93
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- EN1 ; CHECK NURSING EDUCATION DATA
- +1 SET (NURQUIT,NURQUEUE,NUROUT)=0
- +2 SET ZTRTN="START^NURSXECP"
- DO EN7^NURSUT0
- if POP!($DATA(ZTSK))
- GOTO QUIT
- START ;
- +1 KILL ^TMP($JOB)
- SET (NURSW1,NURQUIT,NURPAGE)=0
- FOR DA=0:0
- SET DA=$ORDER(^NURSF(210,DA))
- if DA'>0
- QUIT
- IF +$GET(^NURSF(210,DA,0))
- if $RANDOM(100)
- WRITE "."
- Begin DoDot:1
- +2 SET NAME=$SELECT($PIECE($GET(^VA(200,+$GET(^NURSF(210,DA,0)),0)),U)'="":$PIECE($GET(^VA(200,+$GET(^NURSF(210,DA,0)),0)),U),1:+$GET(^NURSF(210,DA,0)))
- +3 FOR D1=0:0
- SET D1=$ORDER(^NURSF(210,DA,8,D1))
- if D1'>0
- QUIT
- IF '($GET(^NURSF(210,DA,8,D1,0))="")
- Begin DoDot:2
- +4 SET DATA=$GET(^NURSF(210,DA,8,D1,0))
- SET CLASS=$SELECT($DATA(^NURSF(212.4,+$PIECE(DATA,U,2),0)):$PIECE($GET(^NURSF(212.4,+$PIECE(DATA,U,2),0)),U),'(+$PIECE(DATA,U,2)>0):0,1:1)
- SET DATE=+DATA
- DO CHKCLS
- +5 QUIT
- End DoDot:2
- +6 FOR D2=0:0
- SET D2=$ORDER(^NURSF(210,DA,18,D2))
- if D2'>0
- QUIT
- IF '($GET(^NURSF(210,DA,18,D2,0))="")
- Begin DoDot:2
- +7 SET DATA=$GET(^NURSF(210,DA,18,D2,0))
- SET CLASS=$SELECT($PIECE($GET(^NURSF(210,DA,18,D2,0)),U)'="":$PIECE($GET(^(0)),U),1:0)
- SET DATE=+$PIECE($GET(^(0)),U,2)
- DO CHKCLS
- +8 QUIT
- End DoDot:2
- +9 QUIT
- End DoDot:1
- +10 IF $ORDER(^TMP("NURPRSE",$JOB,""))=""
- DO HEADER
- WRITE !,"THERE WERE NO EXCEPTION RECORDS FOUND!"
- GOTO QUIT
- +11 SET NAME=""
- FOR
- SET NAME=$ORDER(^TMP("NURPRSE",$JOB,NAME))
- if NAME=""
- QUIT
- SET CLASS=""
- FOR
- SET CLASS=$ORDER(^TMP("NURPRSE",$JOB,NAME,CLASS))
- if CLASS=""
- QUIT
- SET DATE=""
- FOR
- SET DATE=$ORDER(^TMP("NURPRSE",$JOB,NAME,CLASS,DATE))
- if DATE=""
- QUIT
- Begin DoDot:1
- +12 IF 'NURSW1!($Y>(IOSL-2))
- DO HEADER
- if NURQUIT
- QUIT
- +13 WRITE !,$SELECT(CLASS=" BLANK":"",1:CLASS),?34,$SELECT(DATE=" BLANK":"",1:$EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)),?48,NAME,!,"DISCREPANCY: ",^TMP("NURPRSE",$JOB,NAME,CLASS,DATE),!!
- +14 QUIT
- End DoDot:1
- QUIT ;
- Q KILL ^TMP("NURPRSE",$JOB)
- DO CLOSE^NURSUT1
- DO ^NURSKILL
- +1 QUIT
- CHKCLS IF CLASS=0
- IF +DATE
- SET ^TMP("NURPRSE",$JOB,NAME," BLANK",DATE)="MISSING CLASS NAME"
- +1 IF CLASS=1
- IF +DATE
- SET ^TMP("NURPRSE",$JOB,NAME," BLANK",DATE)="POINTED TO CLASS IS MISSING"
- QUIT
- +2 IF '(+DATE>0)
- SET ^TMP("NURPRSE",$JOB,NAME,CLASS," BLANK")="MISSING CLASS DATE"
- QUIT
- +3 IF +NAME
- SET ^TMP("NURPRSE",$JOB,NAME,CLASS,DATE)="BAD NEW PERSON FILE POINTER"
- +4 IF $DATA(^TMP($JOB,NAME,CLASS,DATE))
- SET ^TMP("NURPRSE",$JOB,NAME,CLASS,DATE)="PREVIOUS ENTRY FOR THIS RECORD/EMPLOYEE"
- +5 SET ^TMP($JOB,NAME,CLASS,DATE)=""
- +6 QUIT
- IF $EXTRACT(IOST)="C"
- IF NURSW1
- WRITE $CHAR(7),!
- READ X:DTIME
- IF '$TEST!(X="^")
- SET NURQUIT=1
- QUIT
- +1 SET X="T"
- SET NURPAGE=NURPAGE+1
- SET NURSW1=1
- DO ^%DT
- if +Y
- DO D^DIQ
- WRITE @IOF,Y,?25,"NURSING EDUCATION DATA EXCEPTION REPORT",?72,"PAGE: ",NURPAGE
- +2 WRITE !!,"CLASS",?35,"DATE",?48,"EMPLOYEE NAME"
- +3 SET X=""
- SET $PIECE(X,"-",80)=""
- WRITE !,X
- +4 QUIT
