source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURSCEP1.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1NURSCEP1 ;HIRMFO/JH/MH-LIST STAFF (#210) FILE DISCREPANCIES - CONT. ;7/15/97
2 ;;4.0;NURSING SERVICE;**6**;Apr 25, 1997
3 S (NURSDA,NURTYPE)=0
4 F S NURSDA=$O(^TMP("NURS",$J,"L",NURSDA)) Q:NURSDA'>0!(NUROUT) S NAME="" F S NAME=$O(^TMP("NURS",$J,"L",NURSDA,NAME)) Q:NAME="" S NUM=^(NAME) D:'NSW1!($Y>(IOSL-6)) HDR Q:$G(NUROUT) W !,NURSDA,?10,NAME D WRT Q:$G(NUROUT) W !
5 I $E(IOST)="C",$D(^TMP("NURS",$J)) D ENDPG^NURSUT1 Q:$G(NUROUT)
6 S (NSW1,NAM)=0,NURTYPE=1
7 F S NAM=$O(^TMP("NURP",$J,NAM)) Q:NAM'>0!(NUROUT) S NOD=0 F S NOD=$O(^TMP("NURP",$J,NAM,NOD)) Q:NOD'>0 S NDA=0 F S NDA=$O(^TMP("NURP",$J,NAM,NOD,NDA)) Q:NDA'>0 S NURX=^TMP("NURP",$J,NAM,NOD,NDA) D PRINT Q:$G(NUROUT)
8 I $E(IOST)="C",$D(^TMP("NURP",$J)) D ENDPG^NURSUT1 Q:$G(NUROUT)
9 S (NSW1,NAM)=0,NURTYPE=2
10 F S NAM=$O(^TMP("NOSTAFF",$J,NAM)) Q:NAM'>0!(NUROUT) S NOD=0 F S NOD=$O(^TMP("NOSTAFF",$J,NAM,NOD)) Q:NOD'>0 S NDA=0 F S NDA=$O(^TMP("NOSTAFF",$J,NAM,NOD,NDA)) Q:NDA'>0 S NURX=^(NDA) D PRINT Q:$G(NUROUT)
11 I $E(IOST)="C",$D(^TMP("NOSTAFF",$J)) D ENDPG^NURSUT1 Q:$G(NUROUT)
12 S (NSW1,NAM)=0,NURTYPE=3
13 F S NAM=$O(^TMP("INACT",$J,NAM)) Q:NAM'>0!(NUROUT) S NOD=0 F S NOD=$O(^TMP("INACT",$J,NAM,NOD)) Q:NOD'>0 S NDA=0 F S NDA=$O(^TMP("INACT",$J,NAM,NOD,NDA)) Q:NDA'>0 S NURX=^(NDA) D PRINT Q:$G(NUROUT)
14 Q
15WRT ;
16 I $Y>(IOSL-6) D HDR Q:$G(NUROUT)
17 S SW=0 F S SW=$O(^TMP("NURS",$J,"L1",NUM,SW)) Q:SW'>0 D
18 . I SW=1 W !?6,"STAFF RECORD HAS NO CORRESPONDING NEW PERSON (#200) FILE ENTRY."
19 . I SW=2 W !?6,"STAFF RECORD CONTAINS MISSING/INVALID DATA IN NAME FIELD."
20 . I SW=3 W !?6,"STAFF RECORD CONTAINS MISSING/INVALID STATUS DATA."
21 . I SW=4 W !?6,"STAFF RECORD MISSING THE `B' INDEX ENTRY."
22 . I SW=5 W !?6,"STAFF RECORD HAS ACTIVE STATUS AND NO CURRENT FILE 211.8 ASSIGNMENT(S)."
23 . I SW=6 W !?6,"STAFF RECORD HAS `B' INDEX ENTRY AND NO DATA ON ZEROTH NODE."
24 . Q
25 Q
26PRINT ; WRITE POSITION CONTROL REPORT DETAIL LINE
27 I 'NSW1!($Y>(IOSL-6)) D HDR Q:$G(NUROUT)
28 W:'(NURTYPE=3) !,NOD_",1,"_NDA_",0)" W:$G(NURTYPE)=3 !,$P($G(^VA(200,+NAM,0)),U) W:'(NURTYPE=3) ?15,$P($G(^VA(200,+NAM,0)),U) W ?40,$P(NURX,U),?53,$E($P(NURX,U,2),1,10),?65,$P(NURX,U,3),?72,$P(NURX,U,4)
29 Q
30STAT(NOD) ; DETERMINE IF THE NURSING LOCATION IS ACTIVE BASED ON A NURS
31 ; POSITION CONTROL FILE POINTER (NOD)
32 N NURSTAT
33 S NURSTAT=0,NPWARD=+$G(^NURSF(211.8,NOD,0)) D EN7^NURSAUTL Q:$G(NPWARD)=""
34 S NURLOC="NUR "_NPWARD,SCDA=$O(^SC("B",NURLOC,0)),NURDA=$O(^NURSF(211.4,"B",+SCDA,0))
35 I $G(^NURSF(211.4,+NURDA,"I"))="I" S NURSTAT=1
36 Q NURSTAT
37HDR I NSW1,'NURQUEUE,'$G(NUROUT),$E(IOST)="C" D ENDPG^NURSUT1 I $G(NUROUT) Q
38 S NURPAGE=(NURPAGE+1) W:$E(IOST)="C"!(NURPAGE>1) @IOF
39 W "NURS POSITION CONTROL/NURS STAFF File Integrity Report " S X="T" D ^%DT D:+Y D^DIQ W ?57,Y,?71," PAGE: ",NURPAGE
40 I NURTYPE=0 W !,"RECORD#",?12,"NAME",!,?6,"DISCREPANCY"
41 I NURTYPE=1!(NURTYPE=2)!(NURTYPE=3) W:NURTYPE=1!(NURTYPE=2) !,"GLOBAL REF." W:NURTYPE=3 !,"NAME" W:'(NURTYPE=3) ?15,"NAME" W ?40,"POSITION",?53,"UNIT",?64,"FTEE",?70,"START DATE"
42 W !,$$REPEAT^XLFSTR("-",80)
43 I NURTYPE=1 W !!,"The following assignments are duplicates in the NURS Position Control (211.8)",!,"File. To deactivate a specific assignment use the global root ^NURSF(211.8,",!,"and the global reference indicated for that assignment:",!!
44 I NURTYPE=2 W !!,"The following assignments have no corresponding Nurs Staff (#210) File entry.",!,"To remove the assignment use the global root ^NURSF(211.8, and the global",!,"reference indicated for that assignment:",!!
45 I NURTYPE=3 W !!,"The following active employees are assigned to inactive nursing locations.",!,"To deactivate or edit a specific assignment use the Status and Position Option",!,"[NURAED-STF-STAT/POS] of the Staff Record Edit",!!
46 S NSW1=1
47 Q
Note: See TracBrowser for help on using the repository browser.