- PRSNUT04 ;;WOIFO/JAH - Nurse Activity for VANOD Utilities;8/25/2009
- ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- Q
- ;
- HASACCES(IEN200,PRSIEN,ACCTYP) ;FUNCTION RETURNS TRUE if the user defined in
- ; parameter IEN200 has access to the Nurse defined in parameter PRSIEN
- ;
- ;INPUT:
- ; IEN200: accessors' internal entry number in file 200 (DUZ)
- ; PRSIEN: nurses' internal entry number in file 450.
- ; ACCTYP: 'E' OR 'A' for data Entry or Approver
- ;
- ;OUTPUT:
- ; HASACCES: function returns true if user has access to this nurse
- ;
- N HASACCES
- S HASACCES=0
- ;
- ; Get T&L unit and default location of Nurse plus division
- ; associated with each
- ;
- ; T&L + division
- N TLE,TLI,TLDIVI,TINDEX,LINDEX
- D GETS^DIQ(450,PRSIEN_",",7,"I","FIELDS(",,)
- S TLE=$G(FIELDS(450,PRSIEN_",",7,"I"))
- S TLI=$O(^PRST(455.5,"B",TLE,0))
- ;
- I TLI>0 D
- . D GETS^DIQ(455.5,TLI_",","20.5","I","FIELDS(",,)
- . S TLDIVI=$G(FIELDS(455.5,TLI_",",20.5,"I"))
- ;
- ; Nurses (PRSIEN) Primary Location + division
- N NLI,NURIE200,LINDEX,NLDIVI
- ;
- S NURIE200=+$G(^PRSPC(PRSIEN,200))
- S NLI=+$$PRIMLOC^PRSNUT03(NURIE200)
- S NLDIVI=$P($$DIV^PRSNUT03("N",+NLI),U,3)
- ;
- ; Build list of all T&Ls and Locations that (APPROVER/ENTRY PERS)
- ; in IEN200 has access to subscripted by group ien and division ien
- ;
- S TINDEX=$S(ACCTYP="E":"AE",ACCTYP="A":"AR",1:"")
- S LINDEX=$S(ACCTYP="E":"AE",ACCTYP="A":"AA",1:"")
- ;
- N TMPGRPS,DIVMAP,DIVGRP,TN,DN
- D TLACC^PRSNUT02(.TMPGRPS,.DIVMAP,.DIVGRP,.TN,.DN,TINDEX,IEN200,DT)
- D NLACC^PRSNUT02(.TMPGRPS,.DIVMAP,.DIVGRP,.TN,.DN,LINDEX,IEN200,DT)
- ;
- ; Array (returned from above calls) and shown below indicates that
- ; the user (IEN200) has access to both 'N' nurse locations
- ; and 'T' t&l units for division 16433 and division 500
- ; the last subscipt is the IEN of the t&l or nurse location
- ;
- ; TMPGRPS("N",16433,4)="3B-WEST 500GA"
- ; TMPGRPS("N",16433,5)="5-NORTH"
- ; TMPGRPS("T",500,222)=110
- ; TMPGRPS("T",500,230)=117
- ;
- ; Check to see if IEN200 (ENTRY/APPROVAL) matches access to the
- ; Nurses (PRSIEN) location or T&L (including correct division
- ; parameter for that access)
- ;
- I TLDIVI>0,$D(TMPGRPS("T",TLDIVI,TLI)) S HASACCES=1
- I NLDIVI>0,$D(TMPGRPS("N",NLDIVI,NLI)) S HASACCES=1
- ;
- Q HASACCES
- ;
- ;=================================================================
- ;
- PIKGROUP(GRPS,GCHOICE,MANY) ;return the groups selected by a user regardless of access
- K GRPS
- ;
- ;INPUT:
- ; GCHOICE: (optional) Flag set to T, N or null
- ; T: user will be prompted for T&L units
- ; N: user will be prompted for Nurse Locations
- ; null: user will be asked T&L units or locations
- ; MANY- (optional) set this flag to true (1) if more than one
- ; group can be selected
- ;
- ;OUTPUT:
- ;PROCEDURE INTERACTS WITH USER AND RETURNS THE FOLLWOING:
- ;
- ; GRPS - An array with the users selected groups subscripted
- ; by .01 field value (t&l external code or location pointer)
- ; GRPS(0) - will contain the number selected followed by either
- ; N,T, or E for Nurse Location, T&L unit or Error
- ; If piece 2 is an E then piece 3 will contain error
- ; description
- ;
- ; Node Definition: an Upparrow delimited string with the following:
- ; PEICE DEFINITION
- ; ===== ==============================
- ; 1 internal entry number of field value of group
- ; 2 IEN of Division associated with this Group
- ; 3 External value of division
- ;
- ; Sample Call:
- ;
- ; D PIKGROUP^PRSNUT04(.G,"T",1)
- ;
- ; Sample Return:
- ;
- ; G(0)="3^N"
- ; G("1E-EAST")="1^16433^500GA"
- ; G("3B-EAST")="6^16433^500GA"
- ; G("3B-WEST")="4^16433^500GA"
- ;
- ; Build temporary list of all possible groups
- ; If user has access to groups in more than one division then
- ; prompt to select a division
- ;
- ; Example of TMPGRPS array
- ;
- ; TMPGRPS("N",500,5)="5-NORTH"
- ; TMPGRPS("N",16433,6)="3B-EAST"
- ; TMPGRPS("N",16436,1)="1E-EAST"
- ; TMPGRPS("T",500,261)=112
- ; TMPGRPS("T",16433,1)=221
- ;
- ; Example of DIVMAP array:
- ; 0 node - total divisions ^ access param set ^ access param not set
- ; other nodes - (IEN file 4)="Station number" (field #99)
- ;
- ; DIVMAP(0)=2
- ; DIVMAP(16433)="500GA^T&L"
- ; DIVMAP(16436)="500GD^NL"
- ;
- N TLI,FIELDS,TLE,TMPGRPS,DIVMAP,LOCI,LOCE,I,DIVNOPAR,EFFECTPP,DIVPARAM
- N NURSLOC,SELDIV,TINDEX,TLDIVI,DIVGRP,DIVI
- ;
- S DIVMAP(0)="0^0^0"
- S TLI=0
- F S TLI=$O(^PRST(455.5,TLI)) Q:TLI'>0 D
- . D GETS^DIQ(455.5,TLI_",",".01;20.5","IE","FIELDS(",,)
- . S TLE=$G(FIELDS(455.5,TLI_",",.01,"E"))
- . S DIVI=$G(FIELDS(455.5,TLI_",",20.5,"I"))
- .;
- . Q:DIVI=""
- .;
- . D GETS^DIQ(4,DIVI_",",".01;99","EI","FIELDS(",,)
- .;
- . S TMPGRPS("T",DIVI,TLI)=TLE
- . S DIVMAP(DIVI)=FIELDS(4,DIVI_",",99,"E")
- . S DIVGRP("T",TLI)=DIVI_U_FIELDS(4,DIVI_",",99,"E")
- K FIELDS
- ;
- S LOCI=0
- F S LOCI=$O(^NURSF(211.4,LOCI)) Q:LOCI'>0 D
- .;
- . D GETS^DIQ(211.4,LOCI_",",".01;.02","IE","FIELDS(",,)
- .;
- . S LOCE=$G(FIELDS(211.4,LOCI_",",.01,"E"))
- . S DIVI=$G(FIELDS(211.4,LOCI_",",.02,"I"))
- .;
- . S NURSLOC=+$$GET1^DIQ(44,+$G(^NURSF(211.4,LOCI,0)),3,"I")
- . D GETS^DIQ(4,NURSLOC_",",".01;99","EI","FIELDS(",,)
- .;
- . Q:DIVI=""
- .;
- . S DIVMAP(NURSLOC)=FIELDS(4,NURSLOC_",",99,"E")
- . S TMPGRPS("N",NURSLOC,LOCI)=LOCE
- . S DIVGRP("N",LOCI)=NURSLOC_U_FIELDS(4,NURSLOC_",",99,"E")
- K FIELDS
- ;
- ;
- I '$D(DIVMAP) S GRPS(0)="0^E^No T&Ls or Locations found with correct division setup." Q
- ;
- ; count number of divisions with t&ls and locations
- ;
- N CNT,DIVI
- S (DIVI,CNT)=0 F S DIVI=$O(DIVMAP(DIVI)) Q:DIVI'>0 S CNT=CNT+1
- ;
- N OUT
- S OUT=0
- I CNT>1 D
- . W !?5,"Location(s) and T&L units are in more than one division"
- . N DIC,X,Y,DUOUT,DTOUT
- . S DIC(0)="AEQMZ"
- . S DIC="^DIC(4,"
- . S DIC("S")="I $D(DIVMAP(Y))"
- . D ^DIC
- . I $D(DUOUT)!$D(DTOUT)!(Y'>0) S OUT=1
- . S SELDIV=$G(Y)
- E D
- . S SELDIV=$O(DIVMAP(0))
- I OUT S GRPS(0)="0^E^user abort" Q
- ;
- ; prompt user for location or T&L within selected division
- ;
- N DIR,DIRUT,X,Y
- I "^N^T^"'[(U_$G(GCHOICE)_U) D
- . S DIR(0)="S^T:T&L Units;N:Nurse Locations"
- . S DIR("A")="Enter Selection"
- . S DIR("?")="Enter whether you want to select T&L units or Locations."
- . D ^DIR
- . S DIVPARAM=Y
- E D
- . S DIVPARAM=GCHOICE
- I $D(DIRUT) S GRPS(0)="0^E^user abort" Q
- ;
- N DIC,X,Y,DUOUT,DTOUT,VAUTSTR,VAUTNI,VAUTVB,OUT,PRSNGR
- S OUT=0
- ; select t&l unit OR nurse location
- I DIVPARAM="T" D
- . S VAUTSTR="T&L Units"
- . S DIC="^PRST(455.5,"
- E D
- . S VAUTSTR="Nurse Location"
- . S DIC="^NURSF(211.4,"
- S DIC(0)="AEQMZ"
- S DIC("S")="I $D(TMPGRPS(DIVPARAM,+SELDIV,+Y))"
- I $G(MANY) D
- . S VAUTNI=2,VAUTVB="PRSNGR"
- . D FIRST^VAUTOMA
- . S (CNT,Y)=0
- . I 'PRSNGR D
- .. F S Y=$O(PRSNGR(Y)) Q:Y="" D
- ... I $D(TMPGRPS(DIVPARAM,+SELDIV,Y)) D
- .... S CNT=CNT+1
- .... S GRPS($G(TMPGRPS(DIVPARAM,+SELDIV,Y)))=+Y_U_$G(DIVGRP(DIVPARAM,+Y))_U_$S(DIVPARAM="N":+$G(^NURSF(211.4,+Y,0)),1:"")
- . E D
- .. ; all groups selected, so update output array with them
- .. F S Y=$O(DIVGRP(DIVPARAM,Y)) Q:Y="" D
- ... I $D(TMPGRPS(DIVPARAM,+SELDIV,Y)) D
- .... S CNT=CNT+1
- .... S GRPS($G(TMPGRPS(DIVPARAM,+SELDIV,Y)))=+Y_U_$G(DIVGRP(DIVPARAM,+Y))_U_$S(DIVPARAM="N":+$G(^NURSF(211.4,+Y,0)),1:"")
- .;
- . S GRPS(0)=CNT_U_$E(DIVPARAM,1,1)
- . I CNT=0 S GRPS(0)="0^E^Nothing Selected" Q
- E D
- . D ^DIC
- . I $D(DUOUT)!$D(DTOUT)!(Y'>0) S OUT=1 Q
- . S GRPS(0)="1"_U_$E(DIVPARAM,1,1)
- . S GRPS($G(TMPGRPS(DIVPARAM,+SELDIV,+Y)))=+Y_U_$G(DIVGRP(DIVPARAM,+Y))_U_$S(DIVPARAM="N":+$G(^NURSF(211.4,+Y,0)),1:"")
- I OUT S GRPS(0)="0^E^user abort" Q
- ;
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNUT04 7948 printed Feb 18, 2025@23:54:15 Page 2
- PRSNUT04 ;;WOIFO/JAH - Nurse Activity for VANOD Utilities;8/25/2009
- +1 ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 QUIT
- +4 ;
- HASACCES(IEN200,PRSIEN,ACCTYP) ;FUNCTION RETURNS TRUE if the user defined in
- +1 ; parameter IEN200 has access to the Nurse defined in parameter PRSIEN
- +2 ;
- +3 ;INPUT:
- +4 ; IEN200: accessors' internal entry number in file 200 (DUZ)
- +5 ; PRSIEN: nurses' internal entry number in file 450.
- +6 ; ACCTYP: 'E' OR 'A' for data Entry or Approver
- +7 ;
- +8 ;OUTPUT:
- +9 ; HASACCES: function returns true if user has access to this nurse
- +10 ;
- +11 NEW HASACCES
- +12 SET HASACCES=0
- +13 ;
- +14 ; Get T&L unit and default location of Nurse plus division
- +15 ; associated with each
- +16 ;
- +17 ; T&L + division
- +18 NEW TLE,TLI,TLDIVI,TINDEX,LINDEX
- +19 DO GETS^DIQ(450,PRSIEN_",",7,"I","FIELDS(",,)
- +20 SET TLE=$GET(FIELDS(450,PRSIEN_",",7,"I"))
- +21 SET TLI=$ORDER(^PRST(455.5,"B",TLE,0))
- +22 ;
- +23 IF TLI>0
- Begin DoDot:1
- +24 DO GETS^DIQ(455.5,TLI_",","20.5","I","FIELDS(",,)
- +25 SET TLDIVI=$GET(FIELDS(455.5,TLI_",",20.5,"I"))
- End DoDot:1
- +26 ;
- +27 ; Nurses (PRSIEN) Primary Location + division
- +28 NEW NLI,NURIE200,LINDEX,NLDIVI
- +29 ;
- +30 SET NURIE200=+$GET(^PRSPC(PRSIEN,200))
- +31 SET NLI=+$$PRIMLOC^PRSNUT03(NURIE200)
- +32 SET NLDIVI=$PIECE($$DIV^PRSNUT03("N",+NLI),U,3)
- +33 ;
- +34 ; Build list of all T&Ls and Locations that (APPROVER/ENTRY PERS)
- +35 ; in IEN200 has access to subscripted by group ien and division ien
- +36 ;
- +37 SET TINDEX=$SELECT(ACCTYP="E":"AE",ACCTYP="A":"AR",1:"")
- +38 SET LINDEX=$SELECT(ACCTYP="E":"AE",ACCTYP="A":"AA",1:"")
- +39 ;
- +40 NEW TMPGRPS,DIVMAP,DIVGRP,TN,DN
- +41 DO TLACC^PRSNUT02(.TMPGRPS,.DIVMAP,.DIVGRP,.TN,.DN,TINDEX,IEN200,DT)
- +42 DO NLACC^PRSNUT02(.TMPGRPS,.DIVMAP,.DIVGRP,.TN,.DN,LINDEX,IEN200,DT)
- +43 ;
- +44 ; Array (returned from above calls) and shown below indicates that
- +45 ; the user (IEN200) has access to both 'N' nurse locations
- +46 ; and 'T' t&l units for division 16433 and division 500
- +47 ; the last subscipt is the IEN of the t&l or nurse location
- +48 ;
- +49 ; TMPGRPS("N",16433,4)="3B-WEST 500GA"
- +50 ; TMPGRPS("N",16433,5)="5-NORTH"
- +51 ; TMPGRPS("T",500,222)=110
- +52 ; TMPGRPS("T",500,230)=117
- +53 ;
- +54 ; Check to see if IEN200 (ENTRY/APPROVAL) matches access to the
- +55 ; Nurses (PRSIEN) location or T&L (including correct division
- +56 ; parameter for that access)
- +57 ;
- +58 IF TLDIVI>0
- IF $DATA(TMPGRPS("T",TLDIVI,TLI))
- SET HASACCES=1
- +59 IF NLDIVI>0
- IF $DATA(TMPGRPS("N",NLDIVI,NLI))
- SET HASACCES=1
- +60 ;
- +61 QUIT HASACCES
- +62 ;
- +63 ;=================================================================
- +64 ;
- PIKGROUP(GRPS,GCHOICE,MANY) ;return the groups selected by a user regardless of access
- +1 KILL GRPS
- +2 ;
- +3 ;INPUT:
- +4 ; GCHOICE: (optional) Flag set to T, N or null
- +5 ; T: user will be prompted for T&L units
- +6 ; N: user will be prompted for Nurse Locations
- +7 ; null: user will be asked T&L units or locations
- +8 ; MANY- (optional) set this flag to true (1) if more than one
- +9 ; group can be selected
- +10 ;
- +11 ;OUTPUT:
- +12 ;PROCEDURE INTERACTS WITH USER AND RETURNS THE FOLLWOING:
- +13 ;
- +14 ; GRPS - An array with the users selected groups subscripted
- +15 ; by .01 field value (t&l external code or location pointer)
- +16 ; GRPS(0) - will contain the number selected followed by either
- +17 ; N,T, or E for Nurse Location, T&L unit or Error
- +18 ; If piece 2 is an E then piece 3 will contain error
- +19 ; description
- +20 ;
- +21 ; Node Definition: an Upparrow delimited string with the following:
- +22 ; PEICE DEFINITION
- +23 ; ===== ==============================
- +24 ; 1 internal entry number of field value of group
- +25 ; 2 IEN of Division associated with this Group
- +26 ; 3 External value of division
- +27 ;
- +28 ; Sample Call:
- +29 ;
- +30 ; D PIKGROUP^PRSNUT04(.G,"T",1)
- +31 ;
- +32 ; Sample Return:
- +33 ;
- +34 ; G(0)="3^N"
- +35 ; G("1E-EAST")="1^16433^500GA"
- +36 ; G("3B-EAST")="6^16433^500GA"
- +37 ; G("3B-WEST")="4^16433^500GA"
- +38 ;
- +39 ; Build temporary list of all possible groups
- +40 ; If user has access to groups in more than one division then
- +41 ; prompt to select a division
- +42 ;
- +43 ; Example of TMPGRPS array
- +44 ;
- +45 ; TMPGRPS("N",500,5)="5-NORTH"
- +46 ; TMPGRPS("N",16433,6)="3B-EAST"
- +47 ; TMPGRPS("N",16436,1)="1E-EAST"
- +48 ; TMPGRPS("T",500,261)=112
- +49 ; TMPGRPS("T",16433,1)=221
- +50 ;
- +51 ; Example of DIVMAP array:
- +52 ; 0 node - total divisions ^ access param set ^ access param not set
- +53 ; other nodes - (IEN file 4)="Station number" (field #99)
- +54 ;
- +55 ; DIVMAP(0)=2
- +56 ; DIVMAP(16433)="500GA^T&L"
- +57 ; DIVMAP(16436)="500GD^NL"
- +58 ;
- +59 NEW TLI,FIELDS,TLE,TMPGRPS,DIVMAP,LOCI,LOCE,I,DIVNOPAR,EFFECTPP,DIVPARAM
- +60 NEW NURSLOC,SELDIV,TINDEX,TLDIVI,DIVGRP,DIVI
- +61 ;
- +62 SET DIVMAP(0)="0^0^0"
- +63 SET TLI=0
- +64 FOR
- SET TLI=$ORDER(^PRST(455.5,TLI))
- if TLI'>0
- QUIT
- Begin DoDot:1
- +65 DO GETS^DIQ(455.5,TLI_",",".01;20.5","IE","FIELDS(",,)
- +66 SET TLE=$GET(FIELDS(455.5,TLI_",",.01,"E"))
- +67 SET DIVI=$GET(FIELDS(455.5,TLI_",",20.5,"I"))
- +68 ;
- +69 if DIVI=""
- QUIT
- +70 ;
- +71 DO GETS^DIQ(4,DIVI_",",".01;99","EI","FIELDS(",,)
- +72 ;
- +73 SET TMPGRPS("T",DIVI,TLI)=TLE
- +74 SET DIVMAP(DIVI)=FIELDS(4,DIVI_",",99,"E")
- +75 SET DIVGRP("T",TLI)=DIVI_U_FIELDS(4,DIVI_",",99,"E")
- End DoDot:1
- +76 KILL FIELDS
- +77 ;
- +78 SET LOCI=0
- +79 FOR
- SET LOCI=$ORDER(^NURSF(211.4,LOCI))
- if LOCI'>0
- QUIT
- Begin DoDot:1
- +80 ;
- +81 DO GETS^DIQ(211.4,LOCI_",",".01;.02","IE","FIELDS(",,)
- +82 ;
- +83 SET LOCE=$GET(FIELDS(211.4,LOCI_",",.01,"E"))
- +84 SET DIVI=$GET(FIELDS(211.4,LOCI_",",.02,"I"))
- +85 ;
- +86 SET NURSLOC=+$$GET1^DIQ(44,+$GET(^NURSF(211.4,LOCI,0)),3,"I")
- +87 DO GETS^DIQ(4,NURSLOC_",",".01;99","EI","FIELDS(",,)
- +88 ;
- +89 if DIVI=""
- QUIT
- +90 ;
- +91 SET DIVMAP(NURSLOC)=FIELDS(4,NURSLOC_",",99,"E")
- +92 SET TMPGRPS("N",NURSLOC,LOCI)=LOCE
- +93 SET DIVGRP("N",LOCI)=NURSLOC_U_FIELDS(4,NURSLOC_",",99,"E")
- End DoDot:1
- +94 KILL FIELDS
- +95 ;
- +96 ;
- +97 IF '$DATA(DIVMAP)
- SET GRPS(0)="0^E^No T&Ls or Locations found with correct division setup."
- QUIT
- +98 ;
- +99 ; count number of divisions with t&ls and locations
- +100 ;
- +101 NEW CNT,DIVI
- +102 SET (DIVI,CNT)=0
- FOR
- SET DIVI=$ORDER(DIVMAP(DIVI))
- if DIVI'>0
- QUIT
- SET CNT=CNT+1
- +103 ;
- +104 NEW OUT
- +105 SET OUT=0
- +106 IF CNT>1
- Begin DoDot:1
- +107 WRITE !?5,"Location(s) and T&L units are in more than one division"
- +108 NEW DIC,X,Y,DUOUT,DTOUT
- +109 SET DIC(0)="AEQMZ"
- +110 SET DIC="^DIC(4,"
- +111 SET DIC("S")="I $D(DIVMAP(Y))"
- +112 DO ^DIC
- +113 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y'>0)
- SET OUT=1
- +114 SET SELDIV=$GET(Y)
- End DoDot:1
- +115 IF '$TEST
- Begin DoDot:1
- +116 SET SELDIV=$ORDER(DIVMAP(0))
- End DoDot:1
- +117 IF OUT
- SET GRPS(0)="0^E^user abort"
- QUIT
- +118 ;
- +119 ; prompt user for location or T&L within selected division
- +120 ;
- +121 NEW DIR,DIRUT,X,Y
- +122 IF "^N^T^"'[(U_$GET(GCHOICE)_U)
- Begin DoDot:1
- +123 SET DIR(0)="S^T:T&L Units;N:Nurse Locations"
- +124 SET DIR("A")="Enter Selection"
- +125 SET DIR("?")="Enter whether you want to select T&L units or Locations."
- +126 DO ^DIR
- +127 SET DIVPARAM=Y
- End DoDot:1
- +128 IF '$TEST
- Begin DoDot:1
- +129 SET DIVPARAM=GCHOICE
- End DoDot:1
- +130 IF $DATA(DIRUT)
- SET GRPS(0)="0^E^user abort"
- QUIT
- +131 ;
- +132 NEW DIC,X,Y,DUOUT,DTOUT,VAUTSTR,VAUTNI,VAUTVB,OUT,PRSNGR
- +133 SET OUT=0
- +134 ; select t&l unit OR nurse location
- +135 IF DIVPARAM="T"
- Begin DoDot:1
- +136 SET VAUTSTR="T&L Units"
- +137 SET DIC="^PRST(455.5,"
- End DoDot:1
- +138 IF '$TEST
- Begin DoDot:1
- +139 SET VAUTSTR="Nurse Location"
- +140 SET DIC="^NURSF(211.4,"
- End DoDot:1
- +141 SET DIC(0)="AEQMZ"
- +142 SET DIC("S")="I $D(TMPGRPS(DIVPARAM,+SELDIV,+Y))"
- +143 IF $GET(MANY)
- Begin DoDot:1
- +144 SET VAUTNI=2
- SET VAUTVB="PRSNGR"
- +145 DO FIRST^VAUTOMA
- +146 SET (CNT,Y)=0
- +147 IF 'PRSNGR
- Begin DoDot:2
- +148 FOR
- SET Y=$ORDER(PRSNGR(Y))
- if Y=""
- QUIT
- Begin DoDot:3
- +149 IF $DATA(TMPGRPS(DIVPARAM,+SELDIV,Y))
- Begin DoDot:4
- +150 SET CNT=CNT+1
- +151 SET GRPS($GET(TMPGRPS(DIVPARAM,+SELDIV,Y)))=+Y_U_$GET(DIVGRP(DIVPARAM,+Y))_U_$SELECT(DIVPARAM="N":+$GET(^NURSF(211.4,+Y,0)),1:"")
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +152 IF '$TEST
- Begin DoDot:2
- +153 ; all groups selected, so update output array with them
- +154 FOR
- SET Y=$ORDER(DIVGRP(DIVPARAM,Y))
- if Y=""
- QUIT
- Begin DoDot:3
- +155 IF $DATA(TMPGRPS(DIVPARAM,+SELDIV,Y))
- Begin DoDot:4
- +156 SET CNT=CNT+1
- +157 SET GRPS($GET(TMPGRPS(DIVPARAM,+SELDIV,Y)))=+Y_U_$GET(DIVGRP(DIVPARAM,+Y))_U_$SELECT(DIVPARAM="N":+$GET(^NURSF(211.4,+Y,0)),1:"")
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +158 ;
- +159 SET GRPS(0)=CNT_U_$EXTRACT(DIVPARAM,1,1)
- +160 IF CNT=0
- SET GRPS(0)="0^E^Nothing Selected"
- QUIT
- End DoDot:1
- +161 IF '$TEST
- Begin DoDot:1
- +162 DO ^DIC
- +163 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y'>0)
- SET OUT=1
- QUIT
- +164 SET GRPS(0)="1"_U_$EXTRACT(DIVPARAM,1,1)
- +165 SET GRPS($GET(TMPGRPS(DIVPARAM,+SELDIV,+Y)))=+Y_U_$GET(DIVGRP(DIVPARAM,+Y))_U_$SELECT(DIVPARAM="N":+$GET(^NURSF(211.4,+Y,0)),1:"")
- End DoDot:1
- +166 IF OUT
- SET GRPS(0)="0^E^user abort"
- QUIT
- +167 ;
- +168 QUIT
- +169 ;