- XHDPCAT ; SLC/JER - Configurator Server Calls ; 25 Jul 2003 9:42 AM
- ;;1.0;HEALTHEVET DESKTOP;;Jul 15, 2003
- INSERT(ERR,CATFLDS) ; Insert ParameterCategory
- N XHDI,FDA,LASTI,LASTS,LASTN,X,XHDDAD,NEWDA
- S X="ONERROR^XHDPCAT",@^%ZOSF("TRAP")
- S XHDI="",(ERR,LASTS,LASTN)=0,LASTI=1
- F S XHDI=$O(CATFLDS(XHDI)) Q:+XHDI'>0 D
- . S FDA($$GETFILE(XHDI),$$GETIENS(XHDI),$$GETORI(XHDI))=CATFLDS(XHDI)
- I $D(FDA)'>9 S ERR="1^Request not well-formed." Q
- D UPDATER(.ERR,.FDA) Q:+ERR
- I '+ERR S NEWDA=$P(ERR,U,2)
- ; If new record's parent doesn't include it as a subCategory, add it
- S XHDDAD=+$P(^XHD(8935.91,NEWDA,0),U,4)
- I +XHDDAD,'+$O(^XHD(8935.91,"SCAT",NEWDA,XHDDAD,0)) D Q:+ERR
- . N FDA,SUBERR
- . S FDA(8935.913,"?+1,"_XHDDAD_",",.01)=(+$O(^XHD(8935.91,1,3,"A"),-1)+1)
- . S FDA(8935.913,"?+1,"_XHDDAD_",",.02)="`"_NEWDA
- . D UPDATER(.SUBERR,.FDA) S:+SUBERR ERR=SUBERR
- ; If there are subcategories, file NEWDA as their parentId
- I +NEWDA D
- . N XHDJ,SUBERR S XHDJ=0
- . F S XHDJ=$O(^XHD(8935.91,NEWDA,3,XHDJ)) Q:+XHDJ'>0!+ERR D
- . . N SUBDA,FDA,IEN,MSG
- . . S SUBDA=$P($G(^XHD(8935.91,NEWDA,3,XHDJ,0)),U,2) Q:+SUBDA'>0
- . . I +$P($G(^XHD(8935.91,SUBDA,0)),U,4)=NEWDA Q
- . . S FDA(8935.91,SUBDA_",",.04)="`"_NEWDA
- . . D FILER(.SUBERR,.FDA,SUBDA) S:+SUBERR ERR=SUBERR
- Q
- ADDPARAM(ERR,CATFLDS) ; Add Parameter to Category
- N XHDI,FDA,PCDA,X S X="ONERROR^XHDPCAT",@^%ZOSF("TRAP")
- S XHDI="",ERR=0,PCDA=+$G(CATFLDS("IEN"))
- I $S('PCDA:1,'$D(^XHD(8935.91,PCDA,0)):1,1:0) D Q
- . S ERR="1^Invalid ID passed."
- L +^XHD(8935.91,PCDA):1
- E D Q
- . S ERR="1^Another process is modifying Category #"_PCDA
- F S XHDI=$O(CATFLDS(XHDI)) Q:+XHDI'>0 D
- . S FDA(8935.912,"?+1,"_PCDA_",",$P(XHDI,U,3))=CATFLDS(XHDI)
- I $D(FDA)'>9 S ERR="1^Request not well-formed." Q
- D UPDATER(.ERR,.FDA)
- L -^XHD(8935.91,PCDA)
- Q
- UPDATER(ERR,FDA) ; Call UPDATE^DIE to create pCats or subCats
- N IEN,MSG
- D UPDATE^DIE("E","FDA","IEN","MSG")
- I $D(MSG("DIERR")) S ERR="1^"_MSG("DIERR",1,"TEXT",1) Q
- S ERR="0^"_IEN(1)_U_IEN(1,0)
- Q
- UPDATE(ERR,CATFLDS) ; Call FILE^DIE to update ParameterCategory
- N XHDI,FDA,X S X="ONERROR^XHDPCAT",@^%ZOSF("TRAP")
- S XHDI="",ERR=0,PCDA=+$G(CATFLDS("IEN"))
- I $S('PCDA:1,'$D(^XHD(8935.91,PCDA,0)):1,1:0) D Q
- . S ERR="1^Invalid ID passed."
- F S XHDI=$O(CATFLDS(XHDI)) Q:+XHDI'>0 D
- . S FDA($$GETFILE(XHDI),$$GETUPIEN(PCDA,XHDI),$$GETORI(XHDI))=CATFLDS(XHDI)
- I $D(FDA)'>9 S ERR="1^Request not well-formed." Q
- D UPDATER(.ERR,.FDA)
- Q
- REMPARAM(ERR,PDEF,PCDA) ; Remove Parameter from Category
- N XHDSDA,XHDI,FDA,X S X="ONERROR^XHDPCAT",@^%ZOSF("TRAP")
- S XHDI="",ERR=0
- I $S('+$G(PCDA):1,'$D(^XHD(8935.91,PCDA,0)):1,1:0) D Q
- . S ERR="1^Invalid ID passed."
- S XHDSDA=$O(^XHD(8935.91,PCDA,2,"C",PDEF,0))
- I +XHDSDA S FDA(8935.912,XHDSDA_","_PCDA_",",.01)="@"
- I $D(FDA)'>9 S ERR="1^Parameter "_PDEF_" not found in Category "_PCDA_"." Q
- D FILER(.ERR,.FDA,PCDA)
- Q
- REMOVE(ERR,PCAT,PARENT) ; Remove Parameter Category from parent
- N XHDSDA,FDA,X S XHDSDA=0,X="ONERROR^XHDPCAT",@^%ZOSF("TRAP")
- ; remove reference to parent
- S FDA(8935.91,PCAT_",",.04)="@"
- ; remove PCAT from parent's subCat multiple
- S XHDSDA=$O(^XHD(8935.91,PARENT,3,"C",PCAT,0))
- I +XHDSDA S FDA(8935.913,XHDSDA_","_PARENT_",",.01)="@"
- I $D(FDA)'>9 S ERR="1^Sub-category not found in Parent Category." Q
- D FILER(.ERR,.FDA,PARENT)
- Q
- DELETE(ERR,PCAT,DELKIDS) ; Delete Parameter Category and all descendents
- N X,FDA,PARENT S X="ONERROR^XHDPCAT",@^%ZOSF("TRAP"),ERR=0
- ; if DELKIDS, remove descendents first
- I +$G(DELKIDS) D Q:+ERR
- . N XHDI S XHDI=0
- . F S XHDI=$O(^XHD(8935.91,PCAT,3,XHDI)) Q:+XHDI'>0!+ERR D
- . . N XHDSDA S XHDSDA=$P($G(^XHD(8935.91,PCAT,3,XHDI,0)),U,2)
- . . I '+XHDSDA S ERR="1^Corrupt Sub-category at PCat #"_PCAT_", seq #"_XHDI Q
- . . D DELETE(.ERR,XHDSDA,1)
- ;Remove the sub-category from its parent prior to deletion
- S PARENT=$P($G(^XHD(8935.91,PCAT,0)),U,4)
- I +PARENT D REMOVE(.ERR,PCAT,PARENT)
- ; delete record
- S FDA(8935.91,PCAT_",",.01)="@"
- I $D(FDA)'>9 S ERR="1^Request not well-formed." Q
- D FILER(.ERR,.FDA,PCAT)
- Q
- FILER(ERR,FDA,XHDDA) ; Call FILE^DIE with FDA to post changes
- I $D(FDA)'>9 S ERR="1^Request not well-formed." Q
- L +^XHD(8935.91,XHDDA):1
- E D Q
- . S ERR="1^Another process is modifying Category #"_XHDDA
- D FILE^DIE("E","FDA","MSG")
- L -^XHD(8935.91,XHDDA)
- I $D(MSG("DIERR")) S ERR="1^"_MSG("DIERR",1,"TEXT",1) Q
- S ERR="0^"_XHDDA
- Q
- ONERROR ; Trap errors
- S ERR="1^"_$TR($$EC^%ZOSV,"^","~")
- D ^%ZTER
- Q
- GETUPIEN(PCDA,XHDI) ; Get IENS for UPDATE call
- Q $S($L(XHDI,U)=3:"?+"_$P(XHDI,U,2)_","_PCDA_",",1:PCDA_",")
- GETFILE(XHDI) ; Get first subscript for FDA
- Q $S($P(XHDI,U)=2:8935.912,$P(XHDI,U)=3:8935.913,1:8935.91)
- GETIENS(XHDI) ; Get IENS for UPDATE^DIE call
- I $L(XHDI,U)=3 D
- . S LASTI=LASTI+$S($P(XHDI,U)'=LASTS:1,$P(XHDI,U,2)'=LASTN:1,1:0)
- . S LASTS=$P(XHDI,U),LASTN=$P(XHDI,U,2)
- Q $S($L(XHDI,U)=3:"?+"_LASTI_",?+1,",1:"?+1,")
- GETORI(XHDI) ; Get field subscript for FDA
- Q $S($L(XHDI,U)=3:$P(XHDI,U,3),1:XHDI)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXHDPCAT 5110 printed Jan 18, 2025@02:58:31 Page 2
- XHDPCAT ; SLC/JER - Configurator Server Calls ; 25 Jul 2003 9:42 AM
- +1 ;;1.0;HEALTHEVET DESKTOP;;Jul 15, 2003
- INSERT(ERR,CATFLDS) ; Insert ParameterCategory
- +1 NEW XHDI,FDA,LASTI,LASTS,LASTN,X,XHDDAD,NEWDA
- +2 SET X="ONERROR^XHDPCAT"
- SET @^%ZOSF("TRAP")
- +3 SET XHDI=""
- SET (ERR,LASTS,LASTN)=0
- SET LASTI=1
- +4 FOR
- SET XHDI=$ORDER(CATFLDS(XHDI))
- if +XHDI'>0
- QUIT
- Begin DoDot:1
- +5 SET FDA($$GETFILE(XHDI),$$GETIENS(XHDI),$$GETORI(XHDI))=CATFLDS(XHDI)
- End DoDot:1
- +6 IF $DATA(FDA)'>9
- SET ERR="1^Request not well-formed."
- QUIT
- +7 DO UPDATER(.ERR,.FDA)
- if +ERR
- QUIT
- +8 IF '+ERR
- SET NEWDA=$PIECE(ERR,U,2)
- +9 ; If new record's parent doesn't include it as a subCategory, add it
- +10 SET XHDDAD=+$PIECE(^XHD(8935.91,NEWDA,0),U,4)
- +11 IF +XHDDAD
- IF '+$ORDER(^XHD(8935.91,"SCAT",NEWDA,XHDDAD,0))
- Begin DoDot:1
- +12 NEW FDA,SUBERR
- +13 SET FDA(8935.913,"?+1,"_XHDDAD_",",.01)=(+$ORDER(^XHD(8935.91,1,3,"A"),-1)+1)
- +14 SET FDA(8935.913,"?+1,"_XHDDAD_",",.02)="`"_NEWDA
- +15 DO UPDATER(.SUBERR,.FDA)
- if +SUBERR
- SET ERR=SUBERR
- End DoDot:1
- if +ERR
- QUIT
- +16 ; If there are subcategories, file NEWDA as their parentId
- +17 IF +NEWDA
- Begin DoDot:1
- +18 NEW XHDJ,SUBERR
- SET XHDJ=0
- +19 FOR
- SET XHDJ=$ORDER(^XHD(8935.91,NEWDA,3,XHDJ))
- if +XHDJ'>0!+ERR
- QUIT
- Begin DoDot:2
- +20 NEW SUBDA,FDA,IEN,MSG
- +21 SET SUBDA=$PIECE($GET(^XHD(8935.91,NEWDA,3,XHDJ,0)),U,2)
- if +SUBDA'>0
- QUIT
- +22 IF +$PIECE($GET(^XHD(8935.91,SUBDA,0)),U,4)=NEWDA
- QUIT
- +23 SET FDA(8935.91,SUBDA_",",.04)="`"_NEWDA
- +24 DO FILER(.SUBERR,.FDA,SUBDA)
- if +SUBERR
- SET ERR=SUBERR
- End DoDot:2
- End DoDot:1
- +25 QUIT
- ADDPARAM(ERR,CATFLDS) ; Add Parameter to Category
- +1 NEW XHDI,FDA,PCDA,X
- SET X="ONERROR^XHDPCAT"
- SET @^%ZOSF("TRAP")
- +2 SET XHDI=""
- SET ERR=0
- SET PCDA=+$GET(CATFLDS("IEN"))
- +3 IF $SELECT('PCDA:1,'$DATA(^XHD(8935.91,PCDA,0)):1,1:0)
- Begin DoDot:1
- +4 SET ERR="1^Invalid ID passed."
- End DoDot:1
- QUIT
- +5 LOCK +^XHD(8935.91,PCDA):1
- +6 IF '$TEST
- Begin DoDot:1
- +7 SET ERR="1^Another process is modifying Category #"_PCDA
- End DoDot:1
- QUIT
- +8 FOR
- SET XHDI=$ORDER(CATFLDS(XHDI))
- if +XHDI'>0
- QUIT
- Begin DoDot:1
- +9 SET FDA(8935.912,"?+1,"_PCDA_",",$PIECE(XHDI,U,3))=CATFLDS(XHDI)
- End DoDot:1
- +10 IF $DATA(FDA)'>9
- SET ERR="1^Request not well-formed."
- QUIT
- +11 DO UPDATER(.ERR,.FDA)
- +12 LOCK -^XHD(8935.91,PCDA)
- +13 QUIT
- UPDATER(ERR,FDA) ; Call UPDATE^DIE to create pCats or subCats
- +1 NEW IEN,MSG
- +2 DO UPDATE^DIE("E","FDA","IEN","MSG")
- +3 IF $DATA(MSG("DIERR"))
- SET ERR="1^"_MSG("DIERR",1,"TEXT",1)
- QUIT
- +4 SET ERR="0^"_IEN(1)_U_IEN(1,0)
- +5 QUIT
- UPDATE(ERR,CATFLDS) ; Call FILE^DIE to update ParameterCategory
- +1 NEW XHDI,FDA,X
- SET X="ONERROR^XHDPCAT"
- SET @^%ZOSF("TRAP")
- +2 SET XHDI=""
- SET ERR=0
- SET PCDA=+$GET(CATFLDS("IEN"))
- +3 IF $SELECT('PCDA:1,'$DATA(^XHD(8935.91,PCDA,0)):1,1:0)
- Begin DoDot:1
- +4 SET ERR="1^Invalid ID passed."
- End DoDot:1
- QUIT
- +5 FOR
- SET XHDI=$ORDER(CATFLDS(XHDI))
- if +XHDI'>0
- QUIT
- Begin DoDot:1
- +6 SET FDA($$GETFILE(XHDI),$$GETUPIEN(PCDA,XHDI),$$GETORI(XHDI))=CATFLDS(XHDI)
- End DoDot:1
- +7 IF $DATA(FDA)'>9
- SET ERR="1^Request not well-formed."
- QUIT
- +8 DO UPDATER(.ERR,.FDA)
- +9 QUIT
- REMPARAM(ERR,PDEF,PCDA) ; Remove Parameter from Category
- +1 NEW XHDSDA,XHDI,FDA,X
- SET X="ONERROR^XHDPCAT"
- SET @^%ZOSF("TRAP")
- +2 SET XHDI=""
- SET ERR=0
- +3 IF $SELECT('+$GET(PCDA):1,'$DATA(^XHD(8935.91,PCDA,0)):1,1:0)
- Begin DoDot:1
- +4 SET ERR="1^Invalid ID passed."
- End DoDot:1
- QUIT
- +5 SET XHDSDA=$ORDER(^XHD(8935.91,PCDA,2,"C",PDEF,0))
- +6 IF +XHDSDA
- SET FDA(8935.912,XHDSDA_","_PCDA_",",.01)="@"
- +7 IF $DATA(FDA)'>9
- SET ERR="1^Parameter "_PDEF_" not found in Category "_PCDA_"."
- QUIT
- +8 DO FILER(.ERR,.FDA,PCDA)
- +9 QUIT
- REMOVE(ERR,PCAT,PARENT) ; Remove Parameter Category from parent
- +1 NEW XHDSDA,FDA,X
- SET XHDSDA=0
- SET X="ONERROR^XHDPCAT"
- SET @^%ZOSF("TRAP")
- +2 ; remove reference to parent
- +3 SET FDA(8935.91,PCAT_",",.04)="@"
- +4 ; remove PCAT from parent's subCat multiple
- +5 SET XHDSDA=$ORDER(^XHD(8935.91,PARENT,3,"C",PCAT,0))
- +6 IF +XHDSDA
- SET FDA(8935.913,XHDSDA_","_PARENT_",",.01)="@"
- +7 IF $DATA(FDA)'>9
- SET ERR="1^Sub-category not found in Parent Category."
- QUIT
- +8 DO FILER(.ERR,.FDA,PARENT)
- +9 QUIT
- DELETE(ERR,PCAT,DELKIDS) ; Delete Parameter Category and all descendents
- +1 NEW X,FDA,PARENT
- SET X="ONERROR^XHDPCAT"
- SET @^%ZOSF("TRAP")
- SET ERR=0
- +2 ; if DELKIDS, remove descendents first
- +3 IF +$GET(DELKIDS)
- Begin DoDot:1
- +4 NEW XHDI
- SET XHDI=0
- +5 FOR
- SET XHDI=$ORDER(^XHD(8935.91,PCAT,3,XHDI))
- if +XHDI'>0!+ERR
- QUIT
- Begin DoDot:2
- +6 NEW XHDSDA
- SET XHDSDA=$PIECE($GET(^XHD(8935.91,PCAT,3,XHDI,0)),U,2)
- +7 IF '+XHDSDA
- SET ERR="1^Corrupt Sub-category at PCat #"_PCAT_", seq #"_XHDI
- QUIT
- +8 DO DELETE(.ERR,XHDSDA,1)
- End DoDot:2
- End DoDot:1
- if +ERR
- QUIT
- +9 ;Remove the sub-category from its parent prior to deletion
- +10 SET PARENT=$PIECE($GET(^XHD(8935.91,PCAT,0)),U,4)
- +11 IF +PARENT
- DO REMOVE(.ERR,PCAT,PARENT)
- +12 ; delete record
- +13 SET FDA(8935.91,PCAT_",",.01)="@"
- +14 IF $DATA(FDA)'>9
- SET ERR="1^Request not well-formed."
- QUIT
- +15 DO FILER(.ERR,.FDA,PCAT)
- +16 QUIT
- FILER(ERR,FDA,XHDDA) ; Call FILE^DIE with FDA to post changes
- +1 IF $DATA(FDA)'>9
- SET ERR="1^Request not well-formed."
- QUIT
- +2 LOCK +^XHD(8935.91,XHDDA):1
- +3 IF '$TEST
- Begin DoDot:1
- +4 SET ERR="1^Another process is modifying Category #"_XHDDA
- End DoDot:1
- QUIT
- +5 DO FILE^DIE("E","FDA","MSG")
- +6 LOCK -^XHD(8935.91,XHDDA)
- +7 IF $DATA(MSG("DIERR"))
- SET ERR="1^"_MSG("DIERR",1,"TEXT",1)
- QUIT
- +8 SET ERR="0^"_XHDDA
- +9 QUIT
- ONERROR ; Trap errors
- +1 SET ERR="1^"_$TRANSLATE($$EC^%ZOSV,"^","~")
- +2 DO ^%ZTER
- +3 QUIT
- GETUPIEN(PCDA,XHDI) ; Get IENS for UPDATE call
- +1 QUIT $SELECT($LENGTH(XHDI,U)=3:"?+"_$PIECE(XHDI,U,2)_","_PCDA_",",1:PCDA_",")
- GETFILE(XHDI) ; Get first subscript for FDA
- +1 QUIT $SELECT($PIECE(XHDI,U)=2:8935.912,$PIECE(XHDI,U)=3:8935.913,1:8935.91)
- GETIENS(XHDI) ; Get IENS for UPDATE^DIE call
- +1 IF $LENGTH(XHDI,U)=3
- Begin DoDot:1
- +2 SET LASTI=LASTI+$SELECT($PIECE(XHDI,U)'=LASTS:1,$PIECE(XHDI,U,2)'=LASTN:1,1:0)
- +3 SET LASTS=$PIECE(XHDI,U)
- SET LASTN=$PIECE(XHDI,U,2)
- End DoDot:1
- +4 QUIT $SELECT($LENGTH(XHDI,U)=3:"?+"_LASTI_",?+1,",1:"?+1,")
- GETORI(XHDI) ; Get field subscript for FDA
- +1 QUIT $SELECT($LENGTH(XHDI,U)=3:$PIECE(XHDI,U,3),1:XHDI)