- PRSNUT03 ;;WOIFO/JAH - Nurse Activity for VANOD Utilities;6/5/2009
- ;;4.0;PAID;**126,142**;Sep 21, 1995;Build 5
- ;;Per VHA Directive 6402, this routine should not be modified.
- Q
- ;
- PRIMLOC(IEN200) ; RETURN NURSES PRIMARY ASSIGMENT LOCATION
- ;
- ;FUNCTION RETURNS Nurses primary assigment from Nursing Service package
- ; piece value
- ; 1 ien of location from 211.4
- ; 2 .01 value which is pointer to 44
- ; 3 external value of .01 field (e.g., 4 WEST)
- ;
- ; INPUT:
- ; PRSIEN: IEN from New Person file (200)
- ;
- Q:IEN200'>0 "0^Nurse not found"
- ;
- N D0
- S D0=$O(^NURSF(210,"B",IEN200,0))
- Q:D0'>0 "0^Nurse not found"
- ;
- ; call returns external name of nurse location in X
- ;
- N X,LOCI,LOCE
- D EN2^NURSUT2
- Q $$NLIEN^PRSNUT03(X)
- ;
- NLIEN(NLE) ;
- ; INPUT:
- ; NLE - nurse location external name (without NUR prefix)
- ; OUTPUT:
- ; function returns 211.4 IEN ^ .01 pointer ^ external
- ;
- N LOCP,LOCI,LOCE,PL
- I NLE="" Q ""
- ;Patch PRS*4.0*142 adds the "O" flag to the FIND^DIC call to prevent incorrect lookups.
- D FIND^DIC(211.4,,".01","MO","NUR "_NLE,,,,,"PL",)
- S LOCP=$G(PL("DILIST",1,1))
- S LOCI=$G(PL("DILIST",2,1))
- S LOCE=$G(PL("DILIST","ID",1,.01))
- Q LOCI_U_LOCP_U_LOCE
- ;
- LOCNOD(LOC) ; given a location in 211.4 return the node necessary to find
- ; all the nurses in 211.8 with that primary location out of the
- ; "D" index on the primary assignment field.
- N POINT44
- S POINT44=+$G(^NURSF(211.4,LOC,0))
- Q:POINT44'>0 -1
- Q +$O(^NURSF(211.8,"B",POINT44,0))
- ;
- PICKNURS(GROUP,VALUE) ; pick a nurse from a t&l or location
- ; INPUT:
- ; GROUP = T for T&L or N for Nurse Location
- ; VALUE = IEN (T&L 455.5 or Nurse Location 211.4)
- ; OUTPUT:
- ; function returns a Nurse file 450 (IEN^external Name)
- ;
- Q:"T^N^"'[(GROUP_U) 0
- Q:VALUE'>0 0
- ;
- N DIC,X,Y,TLE,D,S1,S2,REFD,S3
- S DIC("A")="Select Nurse: "
- S DIC="^PRSPC("
- S DIC(0)="AEQZ"
- I GROUP="T" D
- . S DIC("S")="I $$ISNURSE^PRSNUT01(Y)"
- . S TLE=$P($G(^PRST(455.5,VALUE,0)),U)
- . S D="ATL"_TLE
- . D MIX^DIC1
- E D
- . S REFD=+$G(^NURSF(211.4,VALUE,0))
- . S S3=""
- . ;S DIC("S")="N VA200IEN,NAME I $$ISNURSE^PRSNUT01(Y) S VA200IEN=+$G(^PRSPC(+Y,200)) I VA200IEN S NAME=$P($G(^VA(200,VA200IEN,0)),U) I NAME'="""",$D(^NURSF(211.8,""D"",REFD,NAME,VA200IEN))"
- . S DIC("S")="N VA200IEN I $$ISNURSE^PRSNUT01(Y) S VA200IEN=+$G(^PRSPC(+Y,200)) I VA200IEN,REFD=+$$PRIMLOC^PRSNUT03(VA200IEN)"
- . D ^DIC
- Q Y
- ;
- DIV(GROUP,VALUE) ; Return the division of a location or a T&L unit
- ;
- ; INPUT:
- ; GROUP = T for T&L or N for Nurse Location
- ; VALUE = IEN (T&L 455.5 or Nurse Location 211.4)
- ; OUTPUT:
- ; Function returns division of input group
- ;
- Q:"T^N^"'[(GROUP_U) 0
- N DIV,STANUM,NLP,P4
- I GROUP="N" D
- . S NLP=+$G(^NURSF(211.4,VALUE,0))
- . S P4=+$$GET1^DIQ(44,NLP,3,"I")
- E D
- . S P4=+$$GET1^DIQ(455.5,VALUE,20.5,"I")
- S DIV=$$GET1^DIQ(4,P4,.01,"I")
- S STANUM=$$GET1^DIQ(4,P4,99,"I")
- Q DIV_U_STANUM_U_P4
- ;
- ENTRYPNT ;
- N DIVMAP,DIVS
- D BLDMAP(.DIVMAP)
- S DIVS=$$SELECT(.DIVMAP)
- Q:DIVS=0
- N DIR,DIRUT,SRT,Y,X,SHOW
- S DIR(0)="SB^T:T&L UNIT;N:NURSE LOCATION"
- S DIR("B")="T"
- S DIR("A")="Select Sort: "
- D ^DIR
- Q:$D(DIRUT)
- S SRT=Y
- N DIR,Y,X
- S DIR(0)="Y"
- S DIR("B")="N"
- S DIR("A")="Show Full Nurse Data"
- D ^DIR
- Q:$D(DIRUT)
- S SHOWNURS=Y
- N %ZIS,POP,IOP
- S %ZIS="MQ"
- D ^%ZIS
- Q:POP
- I $D(IO("Q")) D
- . K IO("Q")
- . N ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
- . S ZTDESC="PRSN SHOW ALL NURSES"
- . S ZTRTN="ALNURLST^PRSNUT03(0,SRT,SHOWNURS)"
- . S ZTSAVE("SHOWNURS")=""
- . S ZTSAVE("SRT")=""
- . S ZTSAVE("FLAG")=""
- . S ZTSAVE("DIVMAP(")=""
- . S ZTSAVE("DIVS")=""
- . D ^%ZTLOAD
- . I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" Queued."
- E D
- . D ALNURLST(0,SRT,SHOWNURS)
- Q
- ALNURLST(FLAG,SORT,SHOWNURS) ;List all Nurses in file 450
- ; INPUT:
- ; FLAG - set to true if you want to attempt to add the Nurse
- ; to file 200. this will also convert any numbers in
- ; the name from file 450 to letters
- ; SORT - (required) If "N" will sort by Nurse location, "T"
- ; report sorts by T&L unit.
- ; SHOWNURS - Set to true if you want to see the full info
- ; about a nurses role
- ;
- Q:"T^N^"'[(SORT_U) 0
- U IO
- K ^TMP($J,"PRSN")
- N N2CNT,NCNT
- S (NCNT,N2CNT)=0
- D GATHER
- N STOP
- D REPORT(.STOP)
- D TOTAL(.STOP)
- D ^%ZISC
- Q
- GATHER ;
- N PRSIEN,X,IEN200,SSN,OUT,SSN200,NAME,ZNODE,TLE,NURTYP
- N SRT1,SRT2,NL,SEPFLAG,NLE,NLDIV
- S (PRSIEN)=0
- F S PRSIEN=$O(^PRSPC(PRSIEN)) Q:PRSIEN'>0 D
- . S X=$$ISNURSE^PRSNUT01(PRSIEN)
- . Q:'X
- . S SEPFLAG=$P($G(^PRSPC(PRSIEN,1)),U,33)
- . Q:SEPFLAG="Y"
- . S NCNT=NCNT+1
- . S NURTYP=$P(X,U,2,4)
- . I $G(FLAG) W @IOF,!!!
- . S IEN200=$P($G(^PRSPC(PRSIEN,200)),U)
- . S ZNODE=$G(^PRSPC(PRSIEN,0))
- . S SSN=$P(ZNODE,U,9)
- . S NAME=$P(ZNODE,U)
- . S TLE=$P(ZNODE,U,8)
- . I TLE="" S TLE="NONE"
- . S (NL,NLE,NLDIV)="NONE"
- . I IEN200>0 D
- .. S N2CNT=N2CNT+1
- .. S SSN200=$P($G(^VA(200,IEN200,1)),U,9)
- .. S NL=$$PRIMLOC^PRSNUT03(IEN200)
- .. S NLE=$P(NL,U,3)
- .. I NLE="" S NLE="NONE"
- .. I NL>0 D
- ... S NLDIV=$P(DIVMAP("NL",+NL),U,3)
- .. E D
- ... S (NLDIV,NLE)="NONE"
- . E D
- .. I $G(FLAG) D ADDNRS
- . I NLDIV'="NONE",DIVS'<0,DIVS'=NLDIV Q ;NOT ALL DIVS OR NOT THE DIV WE'RE LOOKING FOR
- . S SRT1=$S($G(SORT)="N":NLE,1:TLE)
- . S SRT2=$S($G(SORT)="N":TLE,1:NLE)
- . S ^TMP($J,"PRSN",SRT1,SRT2,PRSIEN)=SSN_U_NAME_U_IEN200_U_$G(SSN200)_U_NLE_U_TLE
- . S ^TMP($J,"PRSN",SRT1,SRT2,PRSIEN,1)=NURTYP
- Q
- REPORT(STOP) ;
- ;
- ;Print the data in the tmp array by the sort parameter
- ;
- N PAGE,GIEN,PRSIEN,DAT,SD,NL,NTL,TL
- S (PAGE,STOP)=0
- S GROUP=""
- D HDR
- F S GROUP=$O(^TMP($J,"PRSN",GROUP)) Q:GROUP=""!STOP D
- . W !?17,$S($G(SORT)="N":"NURSING LOCATION: ",1:"T&L UNIT: ")
- . I SORT="N" D
- .. S GIEN=$$NLIEN^PRSNUT03(GROUP)
- . E D
- .. S GIEN=$O(^PRST(455.5,"B",GROUP,0))
- . S SD=$$DIV^PRSNUT03(SORT,+GIEN)
- . W GROUP,!,?17,"STATION: ",$P(SD,U)," (",$P(SD,U,2),")"
- . W !?12,"--------------------------------------------"
- . S SRT2=""
- . F S SRT2=$O(^TMP($J,"PRSN",GROUP,SRT2)) Q:SRT2=""!STOP D
- .. S PRSIEN=0
- .. F S PRSIEN=$O(^TMP($J,"PRSN",GROUP,SRT2,PRSIEN)) Q:PRSIEN'>0!STOP D
- ... S DAT=$G(^TMP($J,"PRSN",GROUP,SRT2,PRSIEN))
- ... S NURTYP=$G(^TMP($J,"PRSN",GROUP,SRT2,PRSIEN,1))
- ... S NAME=$P(DAT,U,2)
- ... S IEN200=$P(DAT,U,3)
- ... S NL=$P(DAT,U,5)
- ... S TL=$P(DAT,U,6)
- ... S SSN=$E($P(DAT,U,1),6,9)
- ... W !,NAME,?23,SSN,?28,PRSIEN,?35,IEN200
- ... W ?46,$S($G(SORT)="N":TL,1:NL)
- ... I $G(SHOWNURS) D
- .... W !,?5,$P(NURTYP,U,1),?25,$P(NURTYP,U,2),?50,$P(NURTYP,U,3),!
- ... E D
- .... S X=$P(NURTYP,U)
- .... S NTL=$L(X)
- .... I NTL>15 D
- ..... S DIWL=64
- ..... S DIWF="WC15"
- ..... K ^UTILITY($J,"W")
- ..... D ^DIWP,^DIWW K DIWL,DIWF
- .... E D
- ..... I $X>62 W !
- ..... W ?63,X
- ... I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() D HDR
- ... I $G(FLAG) S STOP=$$ASK^PRSLIB00()
- Q
- TOTAL(STOP) ;
- W !,"ALL DONE" I STOP W ": User Aborted"
- W !,"VA Nurse Count: ",NCNT,!,"Nurses with DUZ: ",N2CNT
- Q
- ADDNRS ;
- ; edit PAID 450 Employee name replaceing digits 0..9 with A..J
- ;
- N NEWNAME
- S NEWNAME=$TR(NAME,"0123456789","ABCDEFGHIJ")
- W !,"NAME: ",NAME,!,"NEW: ",NEWNAME,!,"Y: ",Y,!,"Y(0): ",$G(Y(0))
- N DIE,DR,DA
- S DIE="^PRSPC(",DA=PRSIEN,DR=".01///^S X=NEWNAME" D ^DIE
- ;
- ;
- ; add PAID Nurse employees to file 200
- ;
- N DIC,X,Y
- K DD,DO
- S DIC(0)="LZ",X=NEWNAME,DIC="^VA(200," D FILE^DICN
- ;
- ; edit ssn in 200
- ;
- I +Y D
- . S DIE="^VA(200,",DA=+Y,DR="9///^S X=SSN" D ^DIE
- Q
- HDR ;
- W @IOF
- S PAGE=PAGE+1
- W ?68,"PAGE ",PAGE
- W !," NAME",?21,"SSN",?26,"IEN 450",?35,"IEN 200"
- W ?46,$S($G(SORT)="N":"T&L",1:"PRIM LOC")
- I $G(SHOWNURS) D
- . W !," NURSE ROLE"
- E D
- . W ?64,"NURSE TYPE"
- W !,"======================================================================="
- Q
- ;
- BLDMAP(DIVMAP) ; BUILD A DIVISION MAP OF LOCATIONS
- N DIVINFO,LIEN
- S LIEN=0
- F S LIEN=$O(^NURSF(211.4,LIEN)) Q:LIEN'>0 D
- . S DIVINFO=$$DIV^PRSNUT03("N",LIEN)
- . S DIVMAP("NL",LIEN)=DIVINFO
- . S DIVMAP("IN",$P(DIVINFO,U,3))=$P(DIVINFO,U,1,2)
- Q
- ;
- SELECT(DM) ; Allow selection of one or all from division
- N DIC,DUOUT,DTOUT,X,Y
- S DIC="^DIC(4,",DIC(0)="AEQMZ"
- S DIC("S")="I $D(DM(""IN"",+Y))"
- S DIC("A")="Select Division or Return for All: "
- D ^DIC
- I $D(DUOUT)!$D(DTOUT) Q 0
- Q +Y
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNUT03 8609 printed Feb 18, 2025@23:54:14 Page 2
- PRSNUT03 ;;WOIFO/JAH - Nurse Activity for VANOD Utilities;6/5/2009
- +1 ;;4.0;PAID;**126,142**;Sep 21, 1995;Build 5
- +2 ;;Per VHA Directive 6402, this routine should not be modified.
- +3 QUIT
- +4 ;
- PRIMLOC(IEN200) ; RETURN NURSES PRIMARY ASSIGMENT LOCATION
- +1 ;
- +2 ;FUNCTION RETURNS Nurses primary assigment from Nursing Service package
- +3 ; piece value
- +4 ; 1 ien of location from 211.4
- +5 ; 2 .01 value which is pointer to 44
- +6 ; 3 external value of .01 field (e.g., 4 WEST)
- +7 ;
- +8 ; INPUT:
- +9 ; PRSIEN: IEN from New Person file (200)
- +10 ;
- +11 if IEN200'>0
- QUIT "0^Nurse not found"
- +12 ;
- +13 NEW D0
- +14 SET D0=$ORDER(^NURSF(210,"B",IEN200,0))
- +15 if D0'>0
- QUIT "0^Nurse not found"
- +16 ;
- +17 ; call returns external name of nurse location in X
- +18 ;
- +19 NEW X,LOCI,LOCE
- +20 DO EN2^NURSUT2
- +21 QUIT $$NLIEN^PRSNUT03(X)
- +22 ;
- NLIEN(NLE) ;
- +1 ; INPUT:
- +2 ; NLE - nurse location external name (without NUR prefix)
- +3 ; OUTPUT:
- +4 ; function returns 211.4 IEN ^ .01 pointer ^ external
- +5 ;
- +6 NEW LOCP,LOCI,LOCE,PL
- +7 IF NLE=""
- QUIT ""
- +8 ;Patch PRS*4.0*142 adds the "O" flag to the FIND^DIC call to prevent incorrect lookups.
- +9 DO FIND^DIC(211.4,,".01","MO","NUR "_NLE,,,,,"PL",)
- +10 SET LOCP=$GET(PL("DILIST",1,1))
- +11 SET LOCI=$GET(PL("DILIST",2,1))
- +12 SET LOCE=$GET(PL("DILIST","ID",1,.01))
- +13 QUIT LOCI_U_LOCP_U_LOCE
- +14 ;
- LOCNOD(LOC) ; given a location in 211.4 return the node necessary to find
- +1 ; all the nurses in 211.8 with that primary location out of the
- +2 ; "D" index on the primary assignment field.
- +3 NEW POINT44
- +4 SET POINT44=+$GET(^NURSF(211.4,LOC,0))
- +5 if POINT44'>0
- QUIT -1
- +6 QUIT +$ORDER(^NURSF(211.8,"B",POINT44,0))
- +7 ;
- PICKNURS(GROUP,VALUE) ; pick a nurse from a t&l or location
- +1 ; INPUT:
- +2 ; GROUP = T for T&L or N for Nurse Location
- +3 ; VALUE = IEN (T&L 455.5 or Nurse Location 211.4)
- +4 ; OUTPUT:
- +5 ; function returns a Nurse file 450 (IEN^external Name)
- +6 ;
- +7 if "T^N^"'[(GROUP_U)
- QUIT 0
- +8 if VALUE'>0
- QUIT 0
- +9 ;
- +10 NEW DIC,X,Y,TLE,D,S1,S2,REFD,S3
- +11 SET DIC("A")="Select Nurse: "
- +12 SET DIC="^PRSPC("
- +13 SET DIC(0)="AEQZ"
- +14 IF GROUP="T"
- Begin DoDot:1
- +15 SET DIC("S")="I $$ISNURSE^PRSNUT01(Y)"
- +16 SET TLE=$PIECE($GET(^PRST(455.5,VALUE,0)),U)
- +17 SET D="ATL"_TLE
- +18 DO MIX^DIC1
- End DoDot:1
- +19 IF '$TEST
- Begin DoDot:1
- +20 SET REFD=+$GET(^NURSF(211.4,VALUE,0))
- +21 SET S3=""
- +22 ;S DIC("S")="N VA200IEN,NAME I $$ISNURSE^PRSNUT01(Y) S VA200IEN=+$G(^PRSPC(+Y,200)) I VA200IEN S NAME=$P($G(^VA(200,VA200IEN,0)),U) I NAME'="""",$D(^NURSF(211.8,""D"",REFD,NAME,VA200IEN))"
- +23 SET DIC("S")="N VA200IEN I $$ISNURSE^PRSNUT01(Y) S VA200IEN=+$G(^PRSPC(+Y,200)) I VA200IEN,REFD=+$$PRIMLOC^PRSNUT03(VA200IEN)"
- +24 DO ^DIC
- End DoDot:1
- +25 QUIT Y
- +26 ;
- DIV(GROUP,VALUE) ; Return the division of a location or a T&L unit
- +1 ;
- +2 ; INPUT:
- +3 ; GROUP = T for T&L or N for Nurse Location
- +4 ; VALUE = IEN (T&L 455.5 or Nurse Location 211.4)
- +5 ; OUTPUT:
- +6 ; Function returns division of input group
- +7 ;
- +8 if "T^N^"'[(GROUP_U)
- QUIT 0
- +9 NEW DIV,STANUM,NLP,P4
- +10 IF GROUP="N"
- Begin DoDot:1
- +11 SET NLP=+$GET(^NURSF(211.4,VALUE,0))
- +12 SET P4=+$$GET1^DIQ(44,NLP,3,"I")
- End DoDot:1
- +13 IF '$TEST
- Begin DoDot:1
- +14 SET P4=+$$GET1^DIQ(455.5,VALUE,20.5,"I")
- End DoDot:1
- +15 SET DIV=$$GET1^DIQ(4,P4,.01,"I")
- +16 SET STANUM=$$GET1^DIQ(4,P4,99,"I")
- +17 QUIT DIV_U_STANUM_U_P4
- +18 ;
- ENTRYPNT ;
- +1 NEW DIVMAP,DIVS
- +2 DO BLDMAP(.DIVMAP)
- +3 SET DIVS=$$SELECT(.DIVMAP)
- +4 if DIVS=0
- QUIT
- +5 NEW DIR,DIRUT,SRT,Y,X,SHOW
- +6 SET DIR(0)="SB^T:T&L UNIT;N:NURSE LOCATION"
- +7 SET DIR("B")="T"
- +8 SET DIR("A")="Select Sort: "
- +9 DO ^DIR
- +10 if $DATA(DIRUT)
- QUIT
- +11 SET SRT=Y
- +12 NEW DIR,Y,X
- +13 SET DIR(0)="Y"
- +14 SET DIR("B")="N"
- +15 SET DIR("A")="Show Full Nurse Data"
- +16 DO ^DIR
- +17 if $DATA(DIRUT)
- QUIT
- +18 SET SHOWNURS=Y
- +19 NEW %ZIS,POP,IOP
- +20 SET %ZIS="MQ"
- +21 DO ^%ZIS
- +22 if POP
- QUIT
- +23 IF $DATA(IO("Q"))
- Begin DoDot:1
- +24 KILL IO("Q")
- +25 NEW ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
- +26 SET ZTDESC="PRSN SHOW ALL NURSES"
- +27 SET ZTRTN="ALNURLST^PRSNUT03(0,SRT,SHOWNURS)"
- +28 SET ZTSAVE("SHOWNURS")=""
- +29 SET ZTSAVE("SRT")=""
- +30 SET ZTSAVE("FLAG")=""
- +31 SET ZTSAVE("DIVMAP(")=""
- +32 SET ZTSAVE("DIVS")=""
- +33 DO ^%ZTLOAD
- +34 IF $DATA(ZTSK)
- SET ZTREQ="@"
- WRITE !,"Request "_ZTSK_" Queued."
- End DoDot:1
- +35 IF '$TEST
- Begin DoDot:1
- +36 DO ALNURLST(0,SRT,SHOWNURS)
- End DoDot:1
- +37 QUIT
- ALNURLST(FLAG,SORT,SHOWNURS) ;List all Nurses in file 450
- +1 ; INPUT:
- +2 ; FLAG - set to true if you want to attempt to add the Nurse
- +3 ; to file 200. this will also convert any numbers in
- +4 ; the name from file 450 to letters
- +5 ; SORT - (required) If "N" will sort by Nurse location, "T"
- +6 ; report sorts by T&L unit.
- +7 ; SHOWNURS - Set to true if you want to see the full info
- +8 ; about a nurses role
- +9 ;
- +10 if "T^N^"'[(SORT_U)
- QUIT 0
- +11 USE IO
- +12 KILL ^TMP($JOB,"PRSN")
- +13 NEW N2CNT,NCNT
- +14 SET (NCNT,N2CNT)=0
- +15 DO GATHER
- +16 NEW STOP
- +17 DO REPORT(.STOP)
- +18 DO TOTAL(.STOP)
- +19 DO ^%ZISC
- +20 QUIT
- GATHER ;
- +1 NEW PRSIEN,X,IEN200,SSN,OUT,SSN200,NAME,ZNODE,TLE,NURTYP
- +2 NEW SRT1,SRT2,NL,SEPFLAG,NLE,NLDIV
- +3 SET (PRSIEN)=0
- +4 FOR
- SET PRSIEN=$ORDER(^PRSPC(PRSIEN))
- if PRSIEN'>0
- QUIT
- Begin DoDot:1
- +5 SET X=$$ISNURSE^PRSNUT01(PRSIEN)
- +6 if 'X
- QUIT
- +7 SET SEPFLAG=$PIECE($GET(^PRSPC(PRSIEN,1)),U,33)
- +8 if SEPFLAG="Y"
- QUIT
- +9 SET NCNT=NCNT+1
- +10 SET NURTYP=$PIECE(X,U,2,4)
- +11 IF $GET(FLAG)
- WRITE @IOF,!!!
- +12 SET IEN200=$PIECE($GET(^PRSPC(PRSIEN,200)),U)
- +13 SET ZNODE=$GET(^PRSPC(PRSIEN,0))
- +14 SET SSN=$PIECE(ZNODE,U,9)
- +15 SET NAME=$PIECE(ZNODE,U)
- +16 SET TLE=$PIECE(ZNODE,U,8)
- +17 IF TLE=""
- SET TLE="NONE"
- +18 SET (NL,NLE,NLDIV)="NONE"
- +19 IF IEN200>0
- Begin DoDot:2
- +20 SET N2CNT=N2CNT+1
- +21 SET SSN200=$PIECE($GET(^VA(200,IEN200,1)),U,9)
- +22 SET NL=$$PRIMLOC^PRSNUT03(IEN200)
- +23 SET NLE=$PIECE(NL,U,3)
- +24 IF NLE=""
- SET NLE="NONE"
- +25 IF NL>0
- Begin DoDot:3
- +26 SET NLDIV=$PIECE(DIVMAP("NL",+NL),U,3)
- End DoDot:3
- +27 IF '$TEST
- Begin DoDot:3
- +28 SET (NLDIV,NLE)="NONE"
- End DoDot:3
- End DoDot:2
- +29 IF '$TEST
- Begin DoDot:2
- +30 IF $GET(FLAG)
- DO ADDNRS
- End DoDot:2
- +31 ;NOT ALL DIVS OR NOT THE DIV WE'RE LOOKING FOR
- IF NLDIV'="NONE"
- IF DIVS'<0
- IF DIVS'=NLDIV
- QUIT
- +32 SET SRT1=$SELECT($GET(SORT)="N":NLE,1:TLE)
- +33 SET SRT2=$SELECT($GET(SORT)="N":TLE,1:NLE)
- +34 SET ^TMP($JOB,"PRSN",SRT1,SRT2,PRSIEN)=SSN_U_NAME_U_IEN200_U_$GET(SSN200)_U_NLE_U_TLE
- +35 SET ^TMP($JOB,"PRSN",SRT1,SRT2,PRSIEN,1)=NURTYP
- End DoDot:1
- +36 QUIT
- REPORT(STOP) ;
- +1 ;
- +2 ;Print the data in the tmp array by the sort parameter
- +3 ;
- +4 NEW PAGE,GIEN,PRSIEN,DAT,SD,NL,NTL,TL
- +5 SET (PAGE,STOP)=0
- +6 SET GROUP=""
- +7 DO HDR
- +8 FOR
- SET GROUP=$ORDER(^TMP($JOB,"PRSN",GROUP))
- if GROUP=""!STOP
- QUIT
- Begin DoDot:1
- +9 WRITE !?17,$SELECT($GET(SORT)="N":"NURSING LOCATION: ",1:"T&L UNIT: ")
- +10 IF SORT="N"
- Begin DoDot:2
- +11 SET GIEN=$$NLIEN^PRSNUT03(GROUP)
- End DoDot:2
- +12 IF '$TEST
- Begin DoDot:2
- +13 SET GIEN=$ORDER(^PRST(455.5,"B",GROUP,0))
- End DoDot:2
- +14 SET SD=$$DIV^PRSNUT03(SORT,+GIEN)
- +15 WRITE GROUP,!,?17,"STATION: ",$PIECE(SD,U)," (",$PIECE(SD,U,2),")"
- +16 WRITE !?12,"--------------------------------------------"
- +17 SET SRT2=""
- +18 FOR
- SET SRT2=$ORDER(^TMP($JOB,"PRSN",GROUP,SRT2))
- if SRT2=""!STOP
- QUIT
- Begin DoDot:2
- +19 SET PRSIEN=0
- +20 FOR
- SET PRSIEN=$ORDER(^TMP($JOB,"PRSN",GROUP,SRT2,PRSIEN))
- if PRSIEN'>0!STOP
- QUIT
- Begin DoDot:3
- +21 SET DAT=$GET(^TMP($JOB,"PRSN",GROUP,SRT2,PRSIEN))
- +22 SET NURTYP=$GET(^TMP($JOB,"PRSN",GROUP,SRT2,PRSIEN,1))
- +23 SET NAME=$PIECE(DAT,U,2)
- +24 SET IEN200=$PIECE(DAT,U,3)
- +25 SET NL=$PIECE(DAT,U,5)
- +26 SET TL=$PIECE(DAT,U,6)
- +27 SET SSN=$EXTRACT($PIECE(DAT,U,1),6,9)
- +28 WRITE !,NAME,?23,SSN,?28,PRSIEN,?35,IEN200
- +29 WRITE ?46,$SELECT($GET(SORT)="N":TL,1:NL)
- +30 IF $GET(SHOWNURS)
- Begin DoDot:4
- +31 WRITE !,?5,$PIECE(NURTYP,U,1),?25,$PIECE(NURTYP,U,2),?50,$PIECE(NURTYP,U,3),!
- End DoDot:4
- +32 IF '$TEST
- Begin DoDot:4
- +33 SET X=$PIECE(NURTYP,U)
- +34 SET NTL=$LENGTH(X)
- +35 IF NTL>15
- Begin DoDot:5
- +36 SET DIWL=64
- +37 SET DIWF="WC15"
- +38 KILL ^UTILITY($JOB,"W")
- +39 DO ^DIWP
- DO ^DIWW
- KILL DIWL,DIWF
- End DoDot:5
- +40 IF '$TEST
- Begin DoDot:5
- +41 IF $X>62
- WRITE !
- +42 WRITE ?63,X
- End DoDot:5
- End DoDot:4
- +43 IF (IOSL-5)<$Y
- SET STOP=$$ASK^PRSLIB00()
- DO HDR
- +44 IF $GET(FLAG)
- SET STOP=$$ASK^PRSLIB00()
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +45 QUIT
- TOTAL(STOP) ;
- +1 WRITE !,"ALL DONE"
- IF STOP
- WRITE ": User Aborted"
- +2 WRITE !,"VA Nurse Count: ",NCNT,!,"Nurses with DUZ: ",N2CNT
- +3 QUIT
- ADDNRS ;
- +1 ; edit PAID 450 Employee name replaceing digits 0..9 with A..J
- +2 ;
- +3 NEW NEWNAME
- +4 SET NEWNAME=$TRANSLATE(NAME,"0123456789","ABCDEFGHIJ")
- +5 WRITE !,"NAME: ",NAME,!,"NEW: ",NEWNAME,!,"Y: ",Y,!,"Y(0): ",$GET(Y(0))
- +6 NEW DIE,DR,DA
- +7 SET DIE="^PRSPC("
- SET DA=PRSIEN
- SET DR=".01///^S X=NEWNAME"
- DO ^DIE
- +8 ;
- +9 ;
- +10 ; add PAID Nurse employees to file 200
- +11 ;
- +12 NEW DIC,X,Y
- +13 KILL DD,DO
- +14 SET DIC(0)="LZ"
- SET X=NEWNAME
- SET DIC="^VA(200,"
- DO FILE^DICN
- +15 ;
- +16 ; edit ssn in 200
- +17 ;
- +18 IF +Y
- Begin DoDot:1
- +19 SET DIE="^VA(200,"
- SET DA=+Y
- SET DR="9///^S X=SSN"
- DO ^DIE
- End DoDot:1
- +20 QUIT
- HDR ;
- +1 WRITE @IOF
- +2 SET PAGE=PAGE+1
- +3 WRITE ?68,"PAGE ",PAGE
- +4 WRITE !," NAME",?21,"SSN",?26,"IEN 450",?35,"IEN 200"
- +5 WRITE ?46,$SELECT($GET(SORT)="N":"T&L",1:"PRIM LOC")
- +6 IF $GET(SHOWNURS)
- Begin DoDot:1
- +7 WRITE !," NURSE ROLE"
- End DoDot:1
- +8 IF '$TEST
- Begin DoDot:1
- +9 WRITE ?64,"NURSE TYPE"
- End DoDot:1
- +10 WRITE !,"======================================================================="
- +11 QUIT
- +12 ;
- BLDMAP(DIVMAP) ; BUILD A DIVISION MAP OF LOCATIONS
- +1 NEW DIVINFO,LIEN
- +2 SET LIEN=0
- +3 FOR
- SET LIEN=$ORDER(^NURSF(211.4,LIEN))
- if LIEN'>0
- QUIT
- Begin DoDot:1
- +4 SET DIVINFO=$$DIV^PRSNUT03("N",LIEN)
- +5 SET DIVMAP("NL",LIEN)=DIVINFO
- +6 SET DIVMAP("IN",$PIECE(DIVINFO,U,3))=$PIECE(DIVINFO,U,1,2)
- End DoDot:1
- +7 QUIT
- +8 ;
- SELECT(DM) ; Allow selection of one or all from division
- +1 NEW DIC,DUOUT,DTOUT,X,Y
- +2 SET DIC="^DIC(4,"
- SET DIC(0)="AEQMZ"
- +3 SET DIC("S")="I $D(DM(""IN"",+Y))"
- +4 SET DIC("A")="Select Division or Return for All: "
- +5 DO ^DIC
- +6 IF $DATA(DUOUT)!$DATA(DTOUT)
- QUIT 0
- +7 QUIT +Y
- +8 ;