- 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 Jan 18, 2025@03:58:19 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