DGRRLU4 ;BPFO/MM RPCs for Division preferences - ;11/15/04 11:38
;;5.3;Registration;**538**;Aug 13, 1993
;
START(RESULT,PARAMS) ;Generates division/package preferences in xml format
;
;Called from DGRR PATIENT LKUP PREFERENCES remote procedure call
;
;Input: PARAMS("stationNumber")= station number for institution
; If not defined, defaults to package parameter values.
;
;Output: RESULT contains the preferences for the division. If not
; specified contains the default package parameters.
;
N LINE,DGRRI,DGRRVAL,DGRRATT,DGRRDIV,DGRRDIVN,DGRRLINE,DGRRESLT
S DGRRDIVN=$G(PARAMS("stationNumber"))
S DGRRDIV=$$IEN^XUAF4(DGRRDIVN)
S DGRRLINE=0
K ^TMP($J,"PLU-DIVPREF")
S DGRRESLT="^TMP($J,""PLU-DIVPREF"")"
S RESULT=$NA(@DGRRESLT)
D ADD^DGRRUTL($$XMLHDR^DGRRUTL())
D ADD^DGRRUTL("<preferences>")
D ADD^DGRRUTL("<error/>")
D ADD^DGRRUTL("<institutionPreferences>")
D ADD^DGRRUTL("<stationNumber>"_$$CHARCHK^DGRRUTL($G(DGRRDIVN))_"</stationNumber>")
;
; Gather preference values and build xml file
F DGRRI=1:1 S LINE=$P($T(PREF+DGRRI),";;",2) Q:LINE="QUIT" D
.;Return preferences in precedence order set in Parameter Definition.
.;Will return division values if found. If not defined, returns
.;package default values
.S DGRRVAL=$$GET^XPAR("ALL^DIV.`"_DGRRDIV,$P(LINE,U),1,"E")
.S DGRRATT=$P(LINE,U,2)
.D ADD^DGRRUTL("<"_DGRRATT_">"_$$CHARCHK^DGRRUTL(DGRRVAL)_"</"_DGRRATT_">")
D ADD^DGRRUTL("</institutionPreferences>")
D ADD^DGRRUTL("</preferences>")
Q
;
UPDATE(RESULT,PARAMS) ;Entry point to add or change preference values
;
;Input: PARAMS("stationNumber")=Station # for the institution (Required)
; PARAMS("divPreference",Preference Name)=Value (Required)
;
;Output: Results in xml format
;
N DGRRARY,DGRRDIV,DGRRDIVN,DGRRERR,DGRRI,DGRRESLT,DGRRPREF,DGRRUPD,LINE
S DGRRDIVN=$G(PARAMS("stationNumber"))
S DGRRDIV=+$$IEN^XUAF4(DGRRDIVN)
K ^TMP($J,"PLU-DIVPREF-UPD")
S RESULT=$NA(^TMP($J,"PLU-DIVPREF-UPD"))
; Log error for xml document and quit if invalid station number passed to call.
I 'DGRRDIV D Q
.S DGRRERR="Invalid stationNumber"
.S DGRRUPD="false"
.D XML(DGRRERR,DGRRUPD,RESULT)
; Build array of preferences from parameter preference names.
F DGRRI=1:1 S LINE=$P($T(PREF+DGRRI),";;",2) Q:LINE="QUIT" D
.S DGRRARY($P(LINE,U,2))=$P(LINE,U)
S DGRRPREF=""
F DGRRI=1:1 S DGRRPREF=$O(DGRRARY(DGRRPREF)) Q:DGRRPREF="" D Q:DGRRUPD="false"
.N DGRRPR,DGRRVAL,ERR
.S (DGRRERR,DGRRUPD)=""
.S DGRRPR=$G(DGRRARY(DGRRPREF))
.S DGRRVAL=$G(PARAMS(DGRRPREF))
.;Value and Preference must be defined
.I DGRRPR=""!(DGRRVAL="") D Q
..S DGRRUPD="false"
..S DGRRERR="Invalid Preference "_$S(DGRRPR="":"Name",1:"Value")
.D EN^XPAR("DIV.`"_DGRRDIV,DGRRPR,1,DGRRVAL,.ERR)
.; If no errors, ERR=0. Errors are returned in the format:
.; internal entry number in Dialog file^error text describing error
.I ERR'=0 D Q
..S DGRRUPD="false"
..S DGRRERR=$P(ERR,U,2)
.S DGRRUPD="true"
D XML(DGRRERR,DGRRUPD,RESULT)
Q
XML(DGRRERR,DGRRUPD,DGRRESLT) ;Builds xml document
N DGRRLINE
S DGRRERR=$G(DGRRERR)
S DGRRUPD=$G(DGRRUPD)
S DGRRLINE=0
K @DGRRESLT
D ADD^DGRRUTL($$XMLHDR^DGRRUTL())
D ADD^DGRRUTL("<preferences>")
D ADD^DGRRUTL("<error>"_$$CHARCHK^DGRRUTL(DGRRERR)_"</error>")
D ADD^DGRRUTL("<institutionPreferences>")
D ADD^DGRRUTL("<stationNumber>"_$$CHARCHK^DGRRUTL($G(DGRRDIVN))_"</stationNumber>")
D ADD^DGRRUTL("<preferencesUpdated>"_$$CHARCHK^DGRRUTL(DGRRUPD)_"</preferencesUpdated>")
D ADD^DGRRUTL("</institutionPreferences>")
D ADD^DGRRUTL("</preferences>")
Q
;
PREF ;Parameter definition^divPref received from/returned to calling app
;;DGRR PL MAX NUM PATIENTS RET^maxNumPatients
;;DGRR PL NUM PATIENTS PER PAGE^patientsPerPage
;;DGRR PL PATIENT TYPE^patientType
;;DGRR PL GENDER^gender
;;DGRR PL PRIMARY ELIGIBILITY^primaryEligibility
;;DGRR PL ROOM BED^roomBed
;;DGRR PL SERVICE CONNECTED^serviceConnected
;;DGRR PL VETERAN STATUS^veteranStatus
;;DGRR PL WARD^ward
;;DGRR PL VETERAN IMAGE^veteranImage
;;QUIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRRLU4 4140 printed Sep 23, 2025@20:33:31 Page 2
DGRRLU4 ;BPFO/MM RPCs for Division preferences - ;11/15/04 11:38
+1 ;;5.3;Registration;**538**;Aug 13, 1993
+2 ;
START(RESULT,PARAMS) ;Generates division/package preferences in xml format
+1 ;
+2 ;Called from DGRR PATIENT LKUP PREFERENCES remote procedure call
+3 ;
+4 ;Input: PARAMS("stationNumber")= station number for institution
+5 ; If not defined, defaults to package parameter values.
+6 ;
+7 ;Output: RESULT contains the preferences for the division. If not
+8 ; specified contains the default package parameters.
+9 ;
+10 NEW LINE,DGRRI,DGRRVAL,DGRRATT,DGRRDIV,DGRRDIVN,DGRRLINE,DGRRESLT
+11 SET DGRRDIVN=$GET(PARAMS("stationNumber"))
+12 SET DGRRDIV=$$IEN^XUAF4(DGRRDIVN)
+13 SET DGRRLINE=0
+14 KILL ^TMP($JOB,"PLU-DIVPREF")
+15 SET DGRRESLT="^TMP($J,""PLU-DIVPREF"")"
+16 SET RESULT=$NAME(@DGRRESLT)
+17 DO ADD^DGRRUTL($$XMLHDR^DGRRUTL())
+18 DO ADD^DGRRUTL("<preferences>")
+19 DO ADD^DGRRUTL("<error/>")
+20 DO ADD^DGRRUTL("<institutionPreferences>")
+21 DO ADD^DGRRUTL("<stationNumber>"_$$CHARCHK^DGRRUTL($GET(DGRRDIVN))_"</stationNumber>")
+22 ;
+23 ; Gather preference values and build xml file
+24 FOR DGRRI=1:1
SET LINE=$PIECE($TEXT(PREF+DGRRI),";;",2)
if LINE="QUIT"
QUIT
Begin DoDot:1
+25 ;Return preferences in precedence order set in Parameter Definition.
+26 ;Will return division values if found. If not defined, returns
+27 ;package default values
+28 SET DGRRVAL=$$GET^XPAR("ALL^DIV.`"_DGRRDIV,$PIECE(LINE,U),1,"E")
+29 SET DGRRATT=$PIECE(LINE,U,2)
+30 DO ADD^DGRRUTL("<"_DGRRATT_">"_$$CHARCHK^DGRRUTL(DGRRVAL)_"</"_DGRRATT_">")
End DoDot:1
+31 DO ADD^DGRRUTL("</institutionPreferences>")
+32 DO ADD^DGRRUTL("</preferences>")
+33 QUIT
+34 ;
UPDATE(RESULT,PARAMS) ;Entry point to add or change preference values
+1 ;
+2 ;Input: PARAMS("stationNumber")=Station # for the institution (Required)
+3 ; PARAMS("divPreference",Preference Name)=Value (Required)
+4 ;
+5 ;Output: Results in xml format
+6 ;
+7 NEW DGRRARY,DGRRDIV,DGRRDIVN,DGRRERR,DGRRI,DGRRESLT,DGRRPREF,DGRRUPD,LINE
+8 SET DGRRDIVN=$GET(PARAMS("stationNumber"))
+9 SET DGRRDIV=+$$IEN^XUAF4(DGRRDIVN)
+10 KILL ^TMP($JOB,"PLU-DIVPREF-UPD")
+11 SET RESULT=$NAME(^TMP($JOB,"PLU-DIVPREF-UPD"))
+12 ; Log error for xml document and quit if invalid station number passed to call.
+13 IF 'DGRRDIV
Begin DoDot:1
+14 SET DGRRERR="Invalid stationNumber"
+15 SET DGRRUPD="false"
+16 DO XML(DGRRERR,DGRRUPD,RESULT)
End DoDot:1
QUIT
+17 ; Build array of preferences from parameter preference names.
+18 FOR DGRRI=1:1
SET LINE=$PIECE($TEXT(PREF+DGRRI),";;",2)
if LINE="QUIT"
QUIT
Begin DoDot:1
+19 SET DGRRARY($PIECE(LINE,U,2))=$PIECE(LINE,U)
End DoDot:1
+20 SET DGRRPREF=""
+21 FOR DGRRI=1:1
SET DGRRPREF=$ORDER(DGRRARY(DGRRPREF))
if DGRRPREF=""
QUIT
Begin DoDot:1
+22 NEW DGRRPR,DGRRVAL,ERR
+23 SET (DGRRERR,DGRRUPD)=""
+24 SET DGRRPR=$GET(DGRRARY(DGRRPREF))
+25 SET DGRRVAL=$GET(PARAMS(DGRRPREF))
+26 ;Value and Preference must be defined
+27 IF DGRRPR=""!(DGRRVAL="")
Begin DoDot:2
+28 SET DGRRUPD="false"
+29 SET DGRRERR="Invalid Preference "_$SELECT(DGRRPR="":"Name",1:"Value")
End DoDot:2
QUIT
+30 DO EN^XPAR("DIV.`"_DGRRDIV,DGRRPR,1,DGRRVAL,.ERR)
+31 ; If no errors, ERR=0. Errors are returned in the format:
+32 ; internal entry number in Dialog file^error text describing error
+33 IF ERR'=0
Begin DoDot:2
+34 SET DGRRUPD="false"
+35 SET DGRRERR=$PIECE(ERR,U,2)
End DoDot:2
QUIT
+36 SET DGRRUPD="true"
End DoDot:1
if DGRRUPD="false"
QUIT
+37 DO XML(DGRRERR,DGRRUPD,RESULT)
+38 QUIT
XML(DGRRERR,DGRRUPD,DGRRESLT) ;Builds xml document
+1 NEW DGRRLINE
+2 SET DGRRERR=$GET(DGRRERR)
+3 SET DGRRUPD=$GET(DGRRUPD)
+4 SET DGRRLINE=0
+5 KILL @DGRRESLT
+6 DO ADD^DGRRUTL($$XMLHDR^DGRRUTL())
+7 DO ADD^DGRRUTL("<preferences>")
+8 DO ADD^DGRRUTL("<error>"_$$CHARCHK^DGRRUTL(DGRRERR)_"</error>")
+9 DO ADD^DGRRUTL("<institutionPreferences>")
+10 DO ADD^DGRRUTL("<stationNumber>"_$$CHARCHK^DGRRUTL($GET(DGRRDIVN))_"</stationNumber>")
+11 DO ADD^DGRRUTL("<preferencesUpdated>"_$$CHARCHK^DGRRUTL(DGRRUPD)_"</preferencesUpdated>")
+12 DO ADD^DGRRUTL("</institutionPreferences>")
+13 DO ADD^DGRRUTL("</preferences>")
+14 QUIT
+15 ;
PREF ;Parameter definition^divPref received from/returned to calling app
+1 ;;DGRR PL MAX NUM PATIENTS RET^maxNumPatients
+2 ;;DGRR PL NUM PATIENTS PER PAGE^patientsPerPage
+3 ;;DGRR PL PATIENT TYPE^patientType
+4 ;;DGRR PL GENDER^gender
+5 ;;DGRR PL PRIMARY ELIGIBILITY^primaryEligibility
+6 ;;DGRR PL ROOM BED^roomBed
+7 ;;DGRR PL SERVICE CONNECTED^serviceConnected
+8 ;;DGRR PL VETERAN STATUS^veteranStatus
+9 ;;DGRR PL WARD^ward
+10 ;;DGRR PL VETERAN IMAGE^veteranImage
+11 ;;QUIT
+12 QUIT
