Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRSNUT03

PRSNUT03.m

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